HPAVC/HPAVC CD-ROM.iso/CHFLZ100.ZIP/CHIEFLZ.PAS

Pascal/Delphi Source File | 1996-09-05 | 111KB | 3,672 lines

{
   CHIEFLZ UNIT/DLL, by Dr A Olowofoyeku (the African Chief);
   internet: [e-mail]
   http://ourworld.compuserve.com/homepages/African_Chief/chief.htm

   Version 1.00.

   USES the original LZSSUNIT source, as amended by the Chief,
   and Chris J Rankin. Ported to Win32 (Delphi 2.0) by Chris Rankin.

   // -----------------------------------------------------------//
    * 16-bit ASM functions converted to 32-bit ASM by Chris J Rankin
    * Win32 (Delphi 2.0) code: added by Chris J Rankin

  Package assembled together: 5th September 1996.

  The routines in this package are already being used in some famous
  programs!
}



{----------------------------------------------------------------------}
{to compile to a DLL in Delphi you need to rename this with the
extension .DPR}

{$I LZDefine.inc}   {// defines various things, including "aDLL" //}

{$ifDef aDLL}
 Library ChiefLZ;

 Uses
 {$ifdef Win32}
   ShareMem,    // Because the library exports functions that have
                // long-string results/parameters, we need to use
                // the ShareMem unit. All apps that use this library
                // *must also use ShareMem* - Put DelphiMM.dll on the
                // Path too ...
   Windows,
   LZSS32,
   LZ_Const,
   LZ_DLL,
 {$else Win32}
   LZSS16,
 {$ifdef Windows}
 {$ifdef DPMI}
   WinAPI,
 {$else DPMI}
   WinProcs,
 {$endif DPMI}
 {$endif Windows}
 {$endif Win32}
 {$ifDef Delphi}
   SysUtils,
 {$else Delphi}
   WinDos,
   Strings,
 {$endif Delphi}
   ChfTypes,
   ChfUtils;

{$else aDLL}
 Unit ChiefLZ;
{$endif aDLL}

{------------------------------------------------------------}

{$ifNDef aDLL}
interface
uses
{$ifdef Delphi}
  SysUtils,
{$endif}
  ChfTypes;
{$endif aDLL}

 Const ChiefLZVersionNumber = 100; { version 1.00 }

{$ifdef Win32} Var
{$else}        Const
{$endif} MyLZMarker:Char = '~'; {last char in filenames created automatically}

{////////////////////////////////////////////////////}
{////////////////////////////////////////////////////}
{////////////////////////////////////////////////////}
  {Pascal object encapsulating the functionality of
  this unit - CANNOT BE EXPORTED BY DLL}
{////////////////////////////////////////////////////}
{////////////////////////////////////////////////////}
{$ifndef aDLL}

Type
LZObj={$ifdef Delphi}Class{$else Delphi}Object{$Endif Delphi}
   Constructor {$ifdef Delphi} Create
               {$else}         Init
               {$endif}(Const InfName, OutFName:String);
   {you can init with source and target file names,
   or with blanks - so set the source and target file names
   later
   }

   Destructor {$ifdef Delphi} Destroy; override
              {$else}         Done;    virtual
              {$endif};

   {$ifndef Delphi}
   Procedure SetInputName(Const aName: String);
   {set source file name; absolutely necessary}

   Procedure SetOutputName(Const aName: String);
   {set target file name = if empty, then a default one
   will be used}

   Procedure SetReportProc(const aProc: TLZReportProc);
   {point to procedure to report progress}

   Procedure SetQuestionProc(const aProc: TLZQuestionFunc);
   {point to function to ask question if the target file exists
   already - if nothing is set, then existing target files will
   be overwritten automatically}
   {$endif}

   Function Compress: Longint; virtual;
   {compress the source file >> target file }

   Function Decompress: Longint; virtual;
   {decompress the source file >> target file}

 private
 {$ifdef Delphi}
   FQuestionProc: TLZQuestionFunc;
   FReportProc  : TLZReportProc;
   fInputName,
   fOutputName  : StrType;
   function GetIsInited: boolean;
 public
   property QuestionProc: TLZQuestionFunc read FQuestionProc
                                          write FQuestionProc;
   property ReportProc: TLZReportProc read FReportProc
                                      write FReportProc;
   property IsInited:   boolean read GetIsInited;
   property InputName:  StrType read FInputName write FInputName;
   property OutputName: StrType read FOutputName write FOutputName;
 {$else Delphi}
   IsInited    : boolean;
   QuestionProc: TLZQuestionFunc;
   ReportProc  : TLZReportProc;
   InputName,
   OutputName  : StrType;
 {$endif Delphi}
End{LZOBJ};
{$endif aDLL}
{////////////////////////////////////////////////////}
{////////////////////////////////////////////////////}

{exported INTERFACE functions}
{$ifNDef aDLL}

Function LZCompress(const {$ifdef Win32} Source, Dest:   string
                          {$else}        aSource, aDest: PChar
                          {$endif};
                    LZQuestion: TLZQuestionFunc;
                    aProc:      TLZReportProc):LongInt;
{ This Function is used for compression.
  Source     = Source file name
  Dest       = target file name
  LZQuestion = procedural type to ask for overwrite permission
  aProc      = procedural type to return progress information
}


Function LZDecompress({$ifdef Win32} Source, Dest:  string
                      {$else} const aSource, aDest: PChar
                      {$endif};
                      LZQuestion: TLZQuestionFunc;
                      aProc:      TLZReportProc):LongInt;
{ This functione is used for decompression.
  Source     = Source file name
  Dest       = target file name
  LZQuestion = procedural type to ask for overwrite permission
  aProc      = procedural type to return progress information
}

Function IsChiefLZFile(const fName: {$ifdef Win32} string
                                    {$else}        PChar
                                    {$endif} ): boolean;
{is this an LZ file compressed with this unit?}

Function LZArchive(const fSpec, ArchName: {$ifdef Win32} string
                                          {$else}        PChar
                                          {$endif};
                   LZRecurseDirs: TLZRecurse;
                   aProc:         TLZReportProc): LongInt;
{archive all the files matching "fSpec" into archive "ArchName";
 fSpec = a filespec (e.g., "*.PAS", or a filename containing a list
 of files to be archived - in which case, use "/F=<listfilename>" as
 the fSpec.
 LZRecurseDirs = whether to recurse into subdirectories for matching
 files
}

Function LZDearchive(ArchName: {$ifdef Win32} string
                               {$else}        PChar
                               {$endif};
                    {$ifdef Win32} DefDir: string
                    {$else} const aDefDir: PChar
                    {$endif};
                     LZQuestion: TLZQuestionFunc;
                     aProc:      TLZReportProc;
                     aRename:    TLZRenameFunc): LongInt;
{De-Arc a ChiefLZ archive}

Function IsChiefLZArchive(const fName: {$ifdef Win32} string
                                       {$else}        PChar
                                       {$endif} ): boolean;
{is this an LZ archive file compressed with this unit?}

Function GetChiefLZFileName{$ifdef Win32}(const fName: string): string;
                           {$else} (fName, Dest: PChar): boolean;
                           {$endif}
{if LZ file, then return name (in dest, if not Win32) - else return
 fname (in dest, if not Win32) }

Function GetChiefLZFileSize(fName: {$ifdef Win32} string
                                   {$else}        PChar
                                   {$endif}): LongInt;
{if LZ file then return uncompressed size - else
 return actual filesize. On error, Win32 throws exception; Win16 returns -1 }

function GetChiefLZArchiveInfo(const ArchName: {$ifdef Win32} string
                                               {$else Win32}  PChar
                                               {$endif Win32};
                               var Header: TChiefLZArchiveHeader): boolean;
{ if LZ-Archive then this function returns True, with the header info
  in Header. Otherwise the function returns False }

Function GetChiefLZArchiveSize(const ArchName: {$ifdef Win32} string
                                               {$else Win32}  PChar
                                               {$endif Win32}): LongInt;
{$ifdef aDLL} {$ifdef Win32} stdcall
              {$else Win32}  export
              {$endif Win32};
{$endif aDLL}
{ If ArchName is LZArchive, returns sum of uncompressed file-sizes in archive.
  If not LZArchive then returns size of file ArchName }

Function LZCompressEx(const {$ifdef Win32} Name:  string
                            {$else}        aName: PChar
                            {$endif};
                      ReplaceQuestion: TLZQuestionFunc;
                      aProc:           TLZReportProc): LongInt;
{compress the file aName, and use the filename,
 with the last character replaced by a '~' as the output file
 If target file exists, and autoreplace=false then the
 function exits and returns -100 else the target file
 will be overwritten
}

Function LZDecompressEx({$ifdef Win32} Name: string
                        {$else}       aName: PChar
                        {$endif};
                        ReplaceQuestion: TLZQuestionFunc;
                        aProc:           TLZReportProc): LongInt;
{decompress the file aName, obtaining the output name from
the header automatically
If target file exists, and autoreplace=false then the
function exits and returns -100 else the target file
will be overwritten
}

function GetFullLZName(Const X    : TChiefLZArchiveHeader;
                             Index: Integer): String;
{for internal use}

{$endif aDLL}

{////////////////////////////////////////////////////}

{$ifNDef aDLL}
implementation

uses
  ChfUtils,
{$ifdef Win32}
  LZSS32, Windows, LZ_Const
{$else Win32}
  LZSS16,           { All 16-bit code }
{$ifdef Windows}
  WinProcs          { Win16 }
{$ifndef Delphi}
 ,WinDos, Strings   { TPW / BPW }
{$endif Delphi}
{$else Windows}
  Dos, Strings      { TP / BP }
{$endif Windows}
{$endif Win32};

{$endif aDLL}

{$ifdef Win32}
{
  These constants taken from SysUtils.inc ...
}
{$ifdef Ver90}
const SInOutError   = 65416;
const SFileNotFound = 65417;
const SEndOfFile    = 65421;
{$else Ver90}
  These constants may have changed; Check SysUtils.inc ... or scan
  the String Resource Table from 0-65535 looking for keywords ...
{$endif Ver90}
{$endif Win32}

const ChiefLZSig = 'aChiefM#';
const NulFileDate = 2162688;   { 01/01/1980 12:00a }

{////////////////////////////////////////////////////}

{//// my header to identify LZ file///}
Type
PLZHeader = ^TLZHeader;
TLZHeader = Packed Record
 fName: TLZFileStr;   {filename}
 uSize: LongInt;      {uncompressed size}
 cSize: LongInt;      {compressed size}
 fTime: LongInt;      {time/date stamp}
 Version: TLZVerStr;
 Signature: String[8];  {the identification header}
end;

Type
TLZBigFileRec= packed Record
{is it a directory}
       IsBigDir: Boolean;
{its directory ID}
       BigDirID: Word;
{its parent directory ID}
       BigParentDir: Word;
{is it compressed?}
       BigCompressed: Boolean;
{any version information?}
       BigFileVersion: TLZVerStr;
{compressed sizes}
       BigSizes: LongInt;
{uncompressed sizes}
       uBigSizes:LongInt;
{date/time stamps}
       BigTimes: LongInt;
{file names}
       BigNames: TLZPathStr
end;

PLZArchiveFiles = ^TLZArchiveFiles;
TLZArchiveFiles = Array[1..MaxChiefLZArchiveSize] of TLZBigFileRec;

Const
MySigStr = #4+^M+'ChfLZ'+#5#6#8;
MyLZSignature :String[Length(MySigStr)]= MySigStr;

Const
CopyBufSize=32000;

Type
PBufType=^TBufType;
TBufType=array[1..CopyBufSize] of byte;

{////////////////////////////////////////////////////}

Type  {don't want to use collections because of other versions of TPascal}
PLZDirArray=^TLZDirArray;
TLZDirArray = array[0..MaxChiefLZDirectories] of {$ifdef Win32} string
                                                 {$else Win32}  PString
                                                 {$endif Win32};

{////////////////////////////////////////////////////}
Var
buf : PBufType;
jR  : PLZArchiveFiles;
jR2 : PChiefLZArchiveHeader;
{
  This global variable contains a long-string field in Delphi 2; it must
  therefore be initialised if ChiefLZ is to be made into a DLL ...
  (This is a problem with Delphi v2.00 - v2.01 seems to have fixed this)
}
BlankRec: TLZReportRec {$ifdef Win32} = () {$endif Win32};

{/////////////////////////////////////////////////////////}
var aRead, aWrite: Longint;
var LZReportProc: TLZReportProc {$ifdef Win32} = nil {$endif Win32};
{
  This global variable ensures that MyReadProc() calls LZReportProc()
  only during compression, and that MyWriteProc() calls LZReportProc()
  only during decompression. This is done by setting Decompressing
  to the appropriate value immediately before calling LZEncode() or
  LZDecode().
}
var Decompressing: Boolean;

{/////////////////////////////////////////////////////////}
var InFile, OutFile: file;

{/////////////////////////////////////////////////////////}
{$ifdef Win32}
{
  These are Win32-specific functions that cannot be moved into the more
  general ChfUtils due to their dependance on types defined in ChfTypes
}
function GetTempChiefFileName: string;
var
  RetBuf: PChar;
begin
  GetMem(RetBuf, MAX_PATH);
  try
    if (GetTempPath(MAX_PATH, RetBuf) = 0) or
       (GetTempFileName(RetBuf,'CHF',0,RetBuf) = 0) then
      RaiseError(EChiefLZError,SNoTempFileName);
    SetString(Result,RetBuf,StrLen(RetBuf))
  finally
    FreeMem(RetBuf, MAX_PATH)
  end
end;

function GetFoundFileName(const Search: TSearchRec): string;
begin
  if Length(Search.Name) >= SizeOf(TLZFileStr) then
    Result := string(Search.FindData.cAlternateFileName)
  else
    Result := Search.Name  // Take long filename (if short enough)
end;                       // else take short filename

{$else Win32}

function GetTempChiefFileName(const FName: PChar): boolean; assembler;
asm
{
  Create a temporary file- FName must specify a path + '\', with enough
  room afterwards to append 12 characters.
}
  PUSH DS
  LDS DX, FName
  MOV AH, $5A
  MOV CX, faArchive
{$ifdef Windows}
  CALL DOS3Call
{$else Windows}
  INT $21
{$endif Windows}
  POP DS
  JC @Fail
{
  The file handle refers to an OPEN file; close it so we can open it
  the Pascal way ...
}
  MOV BX, AX
  MOV AH, $3E
{$ifdef Windows}
  CALL DOS3Call
{$else Windows}
  INT $21
{$endif Windows}
{
  Return True if successful, False otherwise ...
}
@Fail:
{$ifdef Delphi}
  DB $0F, $93, $C0  (* setnc al *)
{$else Delphi}
  MOV AL, False
  JC @End
  INC AX
@End:
{$endif Delphi}
end;

{$endif Win32}

{/////////////////////////////////////////////////////////}
{///// is this an LZ compressed file using this unit? ////}
Function IsMyLZFile(Var InFile:file; Var f:TLZHeader):boolean;
var
  OldPos:  LongInt;
  NumRead: Integer;
begin
  OldPos := FilePos(InFile);
  Seek(InFile,0);
  BlockRead(InFile, f, SizeOf(f), NumRead);
  IsMyLZFile := (NumRead = SizeOf(f))
                  and (Length(f.FName) <> 0)
                  and (f.Signature = ChiefLZSig);
  Seek(InFile,OldPos)
end;

{/////////////////////////////////////////////////////////}
{////: normal file copy if not LZ file}
const LZ_UNKNOWN_LENGTH = -1;

type TReporting = (doReportOnRead, doReportOnWrite);

Function MyFCopy(var InFile, OutFile: file;
                 const CopyLength: LongInt;
                 const doReport:   TReporting): LongInt;
{$ifndef Win32} far; {$endif}
Var
p: PBufType;
{
  Turn the enumerated type doReport into a Boolean:
    doReportOnRead  -> False
    doReportOnWrite -> True

  Decompression routines will call MyFCopy() using doReportOnWrite,
  whereas Compression routines will call using doReportOnRead
}
var
ReportingOnWrite: Boolean absolute doReport;

{$ifdef Win32}
NumRead:integer;
BRead:  integer;
{$else}
BRead:  word;
NumRead:word;
NumWrit:word;
{$endif}
{$ifndef Delphi}
Result: LongInt;
{$endif}

begin

{$IFDEF Debug}
   if CopyLength < LZ_UNKNOWN_LENGTH then
   {$ifdef Win32}
     raise EChiefLZDebug.Create('Negative copy-length passed to MyFCopy')
       at AddrOfCaller
   {$else Win32}
     RunErrorMessageAt('Negative copy-length passed to MyFCopy',
                        AddrOfCaller)
   {$endif Win32};
{$ENDIF}
   Result := 0;
   New(p);
 {$ifdef Win32}
   try {finally}
 {$else Win32}
   if p = nil then
     begin
     {$ifndef Delphi}
       MyFCopy := 0;
     {$endif}
       Exit  { ERROR !!! Failed Memory Allocation! }
     end;
 {$endif Win32}

   repeat
     if CopyLength <> LZ_UNKNOWN_LENGTH then
       BRead := Min(CopyLength-Result, SizeOf(p^))
     else
       BRead := SizeOf(p^);
     BlockRead(InFile, p^, BRead, NumRead);

     {compressing - return number of bytes read}
     if Assigned(LZReportProc) and not ReportingOnWrite then
       LZReportProc(BlankRec, NumRead);
{
  If CopyLength <> LZ_UNKNOWN_LENGTH, we know how many bytes we EXPECT
  to be able to read from this file. If BRead <> NumRead, then the
  file must be corrupt ...
}
   {$ifdef Win32}
     if (CopyLength <> LZ_UNKNOWN_LENGTH) and (BRead <> NumRead) then
       RaiseIOError(SEndOfFile,100); { Will exit via `finally...end' }
   {$endif}
{
  This is the EOF condition for when we DON'T know how long the copy is ...
}
     if NumRead = 0 then
       break;
{
  Without the NumWrit parameter, BlockWrite will cause an IO-Error if the disc
  doesn't have room for SizeOf(p) bytes. This is good in Win32, as an exception
  will then be raised.
}
     BlockWrite(OutFile,p^,NumRead {$ifndef Win32}, NumWrit {$endif});
{
  If Win32 version gets this far, then all NumRead chars must have
  been written ...
}
     inc(Result, {$ifdef Win32} NumRead {$else} NumWrit {$endif});

     {de-compressing - return number of bytes written}
     if Assigned(LZReportProc) and ReportingOnWrite then
       LZReportProc(BlankRec, {$ifdef Win32} NumRead {$else} NumWrit {$endif})

   until {$ifndef Win32} (NumWrit<>NumRead) or {$endif}
         ( (CopyLength <> LZ_UNKNOWN_LENGTH) and
           (Result >= CopyLength) );
 {$ifndef Delphi}
   MyFCopy := Result;
 {$endif}
 {$ifdef Win32}
   finally
 {$endif}
     Dispose(p);
 {$ifdef Win32}
   end;
 {$endif}
end;

{/////////////////////////////////////////////////////////}
Function MyReadProc(var ReadBuf): TLZSSWord; {$ifndef Win32} far; {$endif}
{to read from files}
{$ifndef Delphi}
var
  Result: TLZSSWord;
{$endif}

Begin
  BlockRead(InFile, ReadBuf, LZRWBufSize, Result);
  Inc(aRead, Result);

 {compressing - return bytes read}
  if Assigned(LZReportProc) and not Decompressing then
    LZReportProc(BlankRec, Result);

{$ifndef Delphi}
  MyReadProc := Result
{$endif}
End; { MyReadProc }

{/////////////////////////////////////////////////////////}
Function MyWriteProc(var WriteBuf; Count: TLZSSWord): TLZSSWord;
{$ifndef Win32} far; {$endif Win32}
{$ifndef Delphi}
var
  Result: TLZSSWord;
{$endif}
{to write to files}
Begin
  BlockWrite(OutFile, WriteBuf, Count, Result);
  Inc(aWrite, Result);

 {de-compressing - return bytes written}
  if Assigned(LZReportProc) and Decompressing then
    LZReportProc(BlankRec, Result);

{$ifndef Delphi}
  MyWriteProc := Result
{$endif}
End; { MyWriteProc }

{/////////////////////////////////////////////////////////}
Function GetDirIndex(aDir: TLZPathStr; Const DirList: PLZDirArray;
                                       Const Max: TLZSSWord): LongInt;
{find the index of a directory within an array}
Var
  i: TLZSSWord;
begin
{$ifndef Win32}
  aDir := UpperCase(aDir);
{$endif Win32}
  for i := 0 to Max do
    if {$ifdef Win32} AnsiCompareText(aDir, DirList^[i]) = 0
       {$else Win32}  aDir = DirList^[i]^
       {$endif Win32} then
      begin
        GetDirIndex := i;
        Exit
      end;
  GetDirIndex := -1
end;

{/////////////////////////////////////////////////////////}
function CreatePath(Path: TLZPathStr): Integer;
{Iteratively create a directory path}
var
  i:      Integer;
  NewDir: TLZPathStr;
{$ifndef Delphi}
{$ifdef Windows}
  P:      array[0..79] of Char;
{$endif Windows}
  Result: Integer;
{$endif Delphi}
begin
{$ifdef Delphi}
  Path := ExpandFileName(Path);
{$else Delphi}
  {$ifdef Windows}
  FileExpand(P, Str2PChar(Path));
  Path := StrPas(p);
  {$else Windows}
  Path := FExpand(Path);
  {$endif Windows}
{$endif Delphi}

  i := 3;
  Result := 0;

  repeat
    repeat
      Inc(i)
    until (i > Length(Path)) or (Path[i] = '\');
    NewDir := Copy(Path,1,i-1);
    if not DirectoryExists(NewDir) then
      begin
        MkDir(NewDir);         { Win32 throws an exception and exits... }
        {$ifndef Win32}        { We shall catch and handle this     }
        If IOResult <> 0 then  { exception in the calling function. }
          begin
            CreatePath := -1;
            Exit
          end;
       {$endif Win32}
        Inc(Result)
      end
  until i > Length(Path);
{$ifndef Delphi}
  CreatePath := Result;
{$endif}
end;

{/////////////////////////////////////////////////////////}
function GetFullLZName(const     X: TChiefLZArchiveHeader;
                             Index: Integer): string;
{$ifdef aDLL} {$ifdef Win32} stdcall
              {$else Win32}  export
              {$endif Win32}; {$endif aDLL}
{$ifndef Delphi}
var
  Result: string;
{$endif}
begin
  Result := '';
  repeat
    with X.Files[Index] do
      begin
        Result := Names + '\' + Result;
        if not IsDir then
          Index := DirID
        else
          Index := ParentDir
      end
  until Index = 0;
{$ifdef Win32}
  SetLength(Result, Pred(Length(Result)));
{$else Win32}
  Dec(Result[0]);
{$endif Win32}
{$ifndef Delphi}
  GetFullLZName := Result;
{$endif Delphi}
end;

Function GetFileVersion({$ifdef Win32} Const
                        {$endif} fName: String): TLZVerStr;
{$ifndef DPMI}
{$ifdef TPW}
Var
Result: TLZVerStr;
{$endif TPW}
{$endif DPMI}
Begin
  {$ifdef DPMI}
    GetFileVersion := '0'
  {$else DPMI}
  {$ifdef Windows}
  {$ifdef Win32}
    Result := FileVersionInfo(fName, 'FileVersion');
  {$else Win32}
    Result := FileVersionInfo(Str2PChar(fName), 'FileVersion');
  {$endif Win32}
    if Length(Result) = 0 then
      GetFileVersion := '0'
  {$ifndef Delphi}
    else
      GetFileVersion := Result
  {$endif Delphi}
  {$else Windows}
    GetFileVersion := '0'
  {$endif Windows}
  {$endif DPMI}
End;

{/////////////////////////////////////////////////////////}
function GetLZMarkedName(const FName: string): string;
var
  i:   Integer;
  Ext: TLZExtStr;
begin
  Ext := ExtractFileExt(FName);
  i := Length(Ext);
  if i < 2 then             { Ext is either '' or '.' }
    Ext := '.' + MyLZMarker
  else
    Ext[i] := MyLZMarker;
  GetLZMarkedName := ChangeFileExt(FName, Ext)
end;

{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
{
  These are the LZ functions exported from the unit
}
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
Function IsChiefLZArchive(const fName: {$ifdef Win32} string
                                       {$else}        PChar
                                       {$endif} ):boolean;
{$ifdef aDLL} {$ifdef Win32} stdcall
              {$else Win32}  export
              {$endif Win32};
{$endif aDLL}
Var
f:file;
NumRead: TLZSSWord;
{$ifndef Win32}
OldFMode: byte;
{$endif}

Hed : TLZArchiveHeader;

Begin
     IsChiefLZArchive := False;

     if {$ifdef Win32} Length(fName)
        {$else}        StrLen(fName)
        {$endif} = 0 then
       Exit;

  {$ifdef Win32}

    AssignFile(f, fName);
    FileMode := fmOpenRead; { Win32 only allows 0 <= FileMode <= 2 }
  {$I-}                     { However, share access is FILE_SHARE_READ }
    Reset(f, 1);
  {$I+}
    if IOResult = 0 then
      begin
        BlockRead(f, Hed, SizeOf(Hed), NumRead); // No IO-Error; uses NumRead
        CloseFile(f);
        IsChiefLZArchive := (NumRead = SizeOf(Hed)) and
                            (Hed.Signature = MyLZSignature) and
                            (Hed.Count <> 0)
                 // If haven't read SizeOf(Hed) bytes, CAN'T be LZ Archive
      end

   {$else}

    Assign(f, StrPas(fName));
    OldFMode := FileMode;
{
  Open file: we need Read-access, don't need Write-access and *INSIST*
  that no one else can write to it (i.e. corrupt it) until we're done.
}
    FileMode := (fmOpenRead or fmShareDenyWrite);
    Reset(f,1);
    FileMode := OldFMode;
    if IOResult = 0 then
      begin
        BlockRead(f, Hed, SizeOf(Hed), NumRead);
        Close(f);
        IsChiefLZArchive := (NumRead = SizeOf(Hed)) and
                            (Hed.Signature = MyLZSignature) and
                            (Hed.Count <> 0)
      end
   {$endif}
end;

{/////////////////////////////////////////////////////////}
{$ifdef Win32}
Function GetChiefLZFileName(const fName: string): string;
{$ifdef aDLL} stdcall; {$endif aDLL}
var
f: file;
h: TLZHeader;
begin
  AssignFile(f, fName);
  FileMode := fmOpenRead; { Win32 only allows 0 <= FileMode <= 2 }
  Reset(f,1);             { However, share access is FILE_SHARE_READ }
  try
    if IsMyLZFile(f,h) then
      SetString(Result, PChar(@h.fName[1]), Length(h.fName))
    else
      Result := fName
  finally
    CloseFile(f)
  end
end;
{$else}
Function GetChiefLZFileName(fName, Dest:PChar):boolean;
{$ifdef aDLL} export; {$endif aDLL}
Var
h:TLZHeader;
f:file;
{$ifndef Delphi}
Result:boolean;
{$endif}
OldFMode:byte;
Begin
    GetChiefLZFileName := false;
    StrCopy(Dest, fName); {return filename}
    Assign(f, StrPas(fName));
    OldFMode := FileMode;
{
  Open file: we need Read-access, don't need Write access, and *INSIST*
  that no one else can write to it (i.e. corrupt it) until we're done.
}
    FileMode := (fmOpenRead or fmShareDenyWrite);
    Reset(f,1);
    FileMode := OldFMode;
    if IOResult=0 then
      begin
        Result := IsMyLZfile(f,h);
        Close(f);  { Reset() OK, so Close() must succeed }
      {$ifndef Delphi}
        GetChiefLZFileName := Result;
      {$endif Delphi}
        if Result then
          StrPCopy(Dest, h.fName);
      end
end;
{$endif}
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
Function GetChiefLZFileSize(fName: {$ifdef Win32} string
                                   {$else}        PChar
                                   {$endif}):LongInt;
{$ifdef aDLL} {$ifdef Win32} stdcall
              {$else Win32}  export
              {$endif Win32};
{$endif aDLL}
Var
h:TLZHeader;
f:file;
{$ifndef Win32}
OldFMode:byte;
{$endif}

Begin
  {$ifdef Win32}
    AssignFile(f,fName);
    FileMode := fmOpenRead; { Win32 only allows 0 <= FileMode <= 2 }
    Reset(f,1);             { However, share access is FILE_SHARE_READ }
    try
      if IsMyLZFile(f,h) then
        Result := h.uSize
      else
        Result := FileSize(f)
    finally
      CloseFile(f)
    end;
  {$else}
    GetChiefLZFileSize := -1{error};
    Assign(f, StrPas(fName));
    OldFMode := FileMode;
{
  Open file: we need Read-access, don't need Write-access and *INSIST*
  that no one else can write to it (i.e. corrupt it) until we're done.
}
    FileMode := (fmOpenRead or fmShareDenyWrite);
    Reset(f,1);
    FileMode := OldFMode;
    if IOResult=0 then
      begin

        if IsMyLZFile(f,h) then
          GetChiefLZFileSize := h.uSize      {uncompressed size}
        else
          GetChiefLZFileSize := FileSize(f); {actual size}
        Close(f);         { Reset() OK, so Close() cannot fail }

      end;
  {$endif}
end;
{/////////////////////////////////////////////////////////}

function GetChiefLZArchiveInfo(const ArchName: {$ifdef Win32} string
                                               {$else Win32}  PChar
                                               {$endif Win32};
                               var   Header: TChiefLZArchiveHeader): boolean;
{$ifdef aDLL} {$ifdef Win32} stdcall
              {$else Win32}  export
              {$endif Win32};
{$endif aDLL}
var
  f       : file;
  Hed     : TLZArchiveHeader;
{$ifndef Win32}
  OldFMode: byte;
{$endif Win32}
begin
{$ifdef Win32}

  Result := IsChiefLZArchive(ArchName);
  if Result then
    begin
      AssignFile(f,ArchName);
      FileMode := fmOpenRead; { Win32 only allows 0 <= FileMode <= 2 }
      Reset(f,1);             { However, share access is FILE_SHARE_READ }
      try
        BlockRead(f, Hed, SizeOf(Hed)); {read archive header}
        Header.Count := Hed.Count;
        BlockRead(f, Header.Files[1], SizeOf(TLZFileRec)*Hed.Count)
      finally
        CloseFile(f)
      end
    end

{$else Win32}

    GetChiefLZArchiveInfo := False;
    If IsChiefLZArchive(ArchName) then
      begin
        Assign(f, StrPas(ArchName));
        OldFMode := FileMode;
{
  Open file: we need Read-access, don't need Write-access and *INSIST*
  that no one can write to it (i.e. corrupt it) until we're done ...
}
        FileMode := (fmOpenRead or fmShareDenyWrite);
        Reset(f, 1);
        FileMode := OldFMode;
        if IOResult=0 then
          begin
            BlockRead(f, Hed, SizeOf(Hed)); {read archive header}
            If IOResult=0 then
            begin
              Header.Count := Hed.Count;
              BlockRead(f, Header.Files[1], SizeOf(TLZFileRec)*Hed.Count);
              if IOResult=0 then
                GetChiefLZArchiveInfo := True;
              Close(f) { If successful open, Close() MUST succeed here }
            end
          end
      end

{$endif Win32}
End;

{/////////////////////////////////////////////////////////}
Function GetChiefLZArchiveSize(const ArchName: {$ifdef Win32} string
                                               {$else Win32}  PChar
                                               {$endif Win32}): LongInt;
{$ifdef aDLL} {$ifdef Win32} stdcall
              {$else Win32}  export
              {$endif Win32};
{$endif aDLL}
{get uncompressed size of archive}
Var
X: PChiefLZArchiveHeader;
i: Longint;
{$ifndef Delphi}
Result: LongInt;
{$endif Delphi}
Begin
  New(X);
{$ifdef Win32}
  try { finally }
{$endif Win32}
  if not GetChiefLZArchiveInfo(ArchName, X^) then
    GetChiefLZArchiveSize := FSize({$ifdef Win32} ArchName
                                   {$else Win32}  StrPas(ArchName)
                                   {$endif Win32})
  else
    begin
      Result := 0;
      with X^ do
        for i := 1 to Count do
          Inc(Result, Files[i].uSizes);
    {$ifndef Delphi}
      GetChiefLZArchiveSize := Result
    {$endif Delphi}
    end;
{$ifdef Win32}
  finally
{$endif Win32}
  Dispose(X)
{$ifdef Win32}
  end
{$endif Win32}
End;

{/////////////////////////////////////////////////////////}
Function LZCompress(const {$ifdef Win32} Source, Dest:   string
                          {$else}        aSource, aDest: pChar
                          {$endif};
                    LZQuestion  :TLZQuestionFunc;
                    aProc:TLZReportProc):LongInt;
{$ifdef aDLL} {$ifdef Win32} stdcall
              {$else Win32}  export
              {$endif Win32};
{$endif aDLL}
Var
{$ifndef Win32}
OldFMode : byte;
Source,
Dest     : String;
{$endif}
f     : TLZHeader;
RepRec: TLZReportRec;
hT    : LongInt;

Begin

{$ifDef aDLL}
  If IsLZInitialized then
  {$ifdef Win32}
    RaiseError(EChiefLZDLL,SBusyChief);
  {$else}
    begin
      LZCompress := -20;  {already busy}
      Exit
    end;
  {$endif}
{$endif aDLL}

  aRead := 0;
  aWrite:= 0;

  if not LZInit then
  {$ifdef Win32}
    RaiseError(EChiefLZError,SInitFailed);
  {$else}
    begin
      LZCompress := -10;  {unable to init}
      Exit
    end;
  {$endif}

{$ifdef Win32}
  try { finally }
{$endif}

  {$ifdef Win32}
  if (Length(Source)=0) or (Length(Dest)=0) then
    RaiseError(EChiefLZCompress,SInvalidParams);
  if AnsiCompareText(Source, Dest) = 0 then
    RaiseErrorStr(EChiefLZCompress,SSameFileName,Source);
  {$else}
  Source := StrPas(aSource);
  Dest   := StrPas(aDest);
  If (Length(Source)=0) or (Length(Dest)=0) or
                                  (Uppercase(Source)=Uppercase(Dest))
  then
  begin
    LZCompress := -11;  {same source and target}
    LZDone;
    Exit
  end
  {$endif};

  hT := sFTime(Source);

{||| does target file exist already? ||||}
  If FileExists(Dest) then
    begin
      With RepRec do
        begin   {details of Source}
          Names  := Source;
          Sizes  := fSize(Source);
          uSizes := Sizes;
          Times  := hT;
          FileVersion := GetFileVersion(Source);
        end;

      if Assigned(LZQuestion) then
        if LZQuestion(RepRec, Dest) <> LZYes then
          begin
            LZCompress := -100; {target exists - don't overwrite}
          {$ifndef Win32}
            LZDone;
          {$endif}
            Exit
          end
    end
  else
    With RepRec do
      begin
        Names  := Source;
        Times  := ht;
        uSizes := FSize(Source);
        Sizes  := -1;
        FileVersion := GetFileVersion(Source);
      end;
  BlankRec := RepRec;

{$ifdef Win32}
  AssignFile(InFile, Source);
  FileMode := fmOpenRead; { Win32 only allows 0 <= FileMode <= 2 }
  Reset(InFile,1);        { However, share access is FILE_SHARE_READ }
  try { finally }
    AssignFile(OutFile, Dest);
    Rewrite(OutFile,1);
    try { finally }

      If Assigned(aProc) then aProc(RepRec, -1);
      LZReportProc := aProc;

      if IsMyLZFile(InFile, f) then
        LZCompress := MyFCopy(InFile,OutFile,
                               LZ_UNKNOWN_LENGTH,doReportOnRead)
      else                               {already compressed: just copy}
        begin
          FillChar(f, SizeOf(f), 0);
          with f do
            begin
              fName := ExtractFileName(Source);
              fTime := hT;
              Signature := ChiefLZSig;
              uSize := RepRec.USizes{FileSize(InFile)};
              Version := RepRec.FileVersion;
            end;
          BlockWrite(OutFile, f, SizeOf(f)); {write header}

          InBufPtr := LZRWBufSize;
          InBufSize := LZRWBufSize;
          OutBufPtr := 0;
          Height := 0;
          MatchPos := 0;
          MatchLen := 0;
          LastLen := 0;

          FillChar(BinaryTree^, SizeOf(TBinaryTree), 0);
          FillChar(CodeBuf, SizeOf(CodeBuf), 0);
          Decompressing := False;
          LZEncode;

          {go back and rewrite header}
          f.cSize := aWrite;
          Seek(OutFile,0);
          BlockWrite(OutFile, f, SizeOf(f)); {write header}

          LZCompress := aWrite+SizeOf(TLZHeader)
        end

    finally
      FileSetDate(TFileRec(OutFile).Handle, f.fTime);
      CloseFile(OutFile);
      if Assigned(aProc) then
        begin
          RepRec.Names := '';
          aProc(RepRec, -2)
        end
    end
  finally
    CloseFile(InFile)
  end
  finally
    LZDone
  end

{$else}

  Assign(InFile, Source);
  OldFMode := FileMode;
{
  Open file: we need Read-access, don't need Write-access and *INSIST*
  that no one else can write to it (i.e. corrupt it) 'til we're done ...
}
  FileMode := (fmOpenRead or fmShareDenyWrite);
  Reset(InFile, 1);
  FileMode := OldFMode;
  if IOResult<>0 then
    LZCompress := -2
  else begin

  Assign(OutFile, Dest);
  Rewrite(OutFile, 1);
  if IOResult<>0 then
    LZCompress := -3
  else begin

  If Assigned(aProc) then aProc(RepRec, -1);
  LZReportProc := aProc;

  If IsMyLZFile(InFile, f) then
    LZCompress := MyFCopy(InFile,OutFile,LZ_UNKNOWN_LENGTH,doReportOnRead)
  else                                   {already compressed: just copy}
    begin
     FillChar(f, SizeOf(f), 0);
     With f do
       begin
         fName := ExtractFileName(Source);
         fTime := hT;
         uSize := FileSize(InFile);
         Signature  := ChiefLZSig;
         Version := RepRec.FileVersion;
       end;
     BlockWrite(OutFile, f, SizeOf(f)); {write header}

     if IOResult <> 0 then
       LZCompress := -4
     else
       begin
         InBufPtr := LZRWBufSize;
         InBufSize := LZRWBufSize;
         OutBufPtr := 0;
         Height := 0;
         MatchPos := 0;
         MatchLen := 0;
         LastLen := 0;

         FillChar(BinaryTree^, SizeOf(TBinaryTree), 0);
         FillChar(CodeBuf, SizeOf(CodeBuf), 0);
         Decompressing := False;
         LZEncode;

         {go back and rewrite header}
         f.cSize := aWrite;
         Seek(Outfile, 0);if IOResult<>0 then;
         BlockWrite(OutFile, f, SizeOf(f)); {write header}

         LZCompress := aWrite+SizeOf(TLZHeader)
       end
    end;

  if Assigned(aProc) then
    begin
      RepRec.Names := '';
      aProc(RepRec, -2)
    end;

  { set date/time stamp }
{$ifdef Delphi}
  FileSetDate(TFileRec(OutFile).Handle, f.fTime);
{$else}
  SetFTime(OutFile, f.fTime);
{$endif}

  Close(OutFile);if IOResult<>0 then;
  end; { IOResult = 0 }

  Close(InFile);if IOResult<>0 then;
  end; { IOResult = 0 }

  LZDone
{$endif}
End; { LZCompress }
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
Function LZDecompress({$ifdef Win32} Source, Dest:  string
                      {$else} const aSource, aDest: PChar
                      {$endif};
                      LZQuestion: TLZQuestionFunc;
                      aProc:      TLZReportProc):LongInt;
{$ifdef aDLL} {$ifdef Win32} stdcall
              {$else Win32}  export
              {$endif Win32};
{$endif aDLL}

Var
f     : TLZHeader;
hT    : LongInt;
RepRec: TLZReportRec;
IsComp: Boolean;

{$ifndef Win32}
Source,
UpSource,
Dest    : TLZPathStr;
OldFMode: Byte;
LZReply : TLZReply;
{$endif}
p    : {$ifdef Win32} string;
       {$else}        array[0..79] of Char;
       {$endif}

Begin

{$ifDef aDLL}
  If IsLZInitialized then
  {$ifdef Win32}
    RaiseError(EChiefLZDLL,SBusyChief);
  {$else}
    begin
      LZDecompress := -20;  {already busy}
      Exit
    end
  {$endif};
{$endif aDLL}

  aRead := 0;
  aWrite:=0;

  if not LZInit then
  {$ifdef Win32}
    RaiseError(EChiefLZError,SInitFailed);
  {$else}
    begin
      LZDecompress := -10;  {unable to init}
      Exit
    end;
  {$endif}

{$ifdef Win32}
  try { finally }

  if (Length(Source)=0) or (Length(Dest)=0) then
    RaiseError(EChiefLZCompress,SInvalidParams);

  Source := ExpandFileName(Source);
  Dest   := ExpandFileName(Dest);
{
  Do case-insensitive comparison of full pathnames ...
}
  if AnsiCompareText(Source, Dest) = 0 then
    RaiseErrorStr(EChiefLZCompress,SSameFileName,Source);

{$else}

  Source   := StrPas(aSource);
  UpSource := Uppercase(Source);
  Dest     := StrPas(aDest);
  If (Length(Source)=0) or (Length(Dest)=0)
        or (UpSource=Uppercase(Dest))
  then
    LZDecompress := -11
  else begin

{$endif}

  {see if source file exists}
  {$ifdef Win32}
    p := '';
  {$else}
    p[0] := #0;
  {$endif}

    If Not FileExists(Source) then {look for name ending with MyLZMarker}
    begin
       Source := GetLZMarkedName(Source);
{
  Win32 will raise the correct exception automatically when
  GetChiefLZFileName() attempts to open Source ...
}
     {$ifdef Win32}

       p := GetChiefLZFileName(Source);
       if AnsiCompareText(ExtractFileName(p),
                          ExtractFileName(Source)) <> 0 then
         RaiseErrorStr(EChiefLZCompress,SWrongCompressedFile,p);

     {$else}

       If Not FileExists(Source) then {source file not found}
         begin
           LZDecompress := -12;
           LZDone;
           Exit
         end;

       GetChiefLZFileName(Str2PChar(Source), p); {read header}
       If (ExtractFileName(Uppercase(StrPas(p)))
            <> ExtractFileName(UpSource)) {wrong uncompressed file}
       then begin
          LZDecompress := -3; {wrong file}
          LZDone;
          Exit
        end;
     {$endif}
    end;

    {not FileExists}
  {||||||||}
  hT := sFTime(Source);

  {$ifdef Win32}

  AssignFile(InFile, Source);
  FileMode := fmOpenRead; { Win32 only allows 0 <= FileMode <= 2 }
  Reset(InFile, 1);       { However, share access is FILE_SHARE_READ }
  try { finally }

  {$else Win32}

  Assign(InFile, Source);
  OldFMode := FileMode;
  FileMode := (fmOpenRead or fmShareDenyWrite); {using these constants causes problems!}
  Reset(InFile, 1);                         { Only if file is already open for       }
  FileMode := OldFMode;                     { *writing* to by another process.       }
                                            { If a write happens during decomression }
  if IOResult <> 0 then                     { then the decompressed file is worthless}
    LZDecompress := -12 {can't open source}
  else begin

  {$endif Win32}

  IsComp := IsMyLZFile(InFile, f);

{||| does target file exist already? ||||}
  If FileExists(Dest) then begin
    with RepRec do
      If IsComp then
        begin {send details of Source(compressed) file}
          Names  := {AddBackSlash(ExtractFilePath(Source))+}f.fName{Source};
          Sizes  := f.cSize;
          uSizes := f.uSize;
          Times  := f.fTime;
          FileVersion := f.Version;
        end
      else begin
        Names  := Source;
        Sizes  := FileSize(InFile);
        uSizes := Sizes;
        Times  := hT;
        FileVersion := GetFileVersion(Source);
      end;

    if Assigned(LZQuestion) then    { and send name of existing target file}
    {$ifdef Win32}
      case LZQuestion(RepRec, Dest) of
        LZNo:   begin
                  LZDecompress := -100; {target exists - don't overwrite}
                  Exit
                end;
        LZQuit: Abort { Raises a silent-exception... Fast-track exit   }
      end             { out of entire application unless caught... :-) }
    {$else Win32}
      begin
        LZReply := LZQuestion(RepRec, Dest);
        if LZReply <> LZYes then
          begin
            if LZReply = LZNo then
              LZDecompress := -100   { Exit nicely ... }
            else
              LZDecompress := -150;  { ABORT!!!!!!!    }
            Close(InFile); { Reset() successful; Close() cannot fail }
            LZDone;
            Exit
          end
      end
    {$endif Win32}

  End;

  {report on target file}
  With RepRec do begin
     Names := Dest;
     If IsComp then begin
        Sizes  := f.cSize;
        uSizes := f.uSize;
        Times  := f.fTime;
        FileVersion := f.Version;
     end else begin
       Sizes  := fSize(Source);
       uSizes := Sizes;
       Times  := hT;
       FileVersion := '0';
     end;
  end;

  BlankRec := RepRec;

{$ifdef Win32}
    AssignFile(OutFile, Dest);
    Rewrite(OutFile, 1);
    try { finally }

      {//////////}
      if Assigned(aProc) then aProc(RepRec, -1);
      LZReportProc := aProc;
      {//////////}
      if not IsComp then
        begin {normal copy}
          f.fTime := hT{lFTime(InFile)};
          LZDecompress := MyFCopy(InFile,OutFile,
                                  LZ_UNKNOWN_LENGTH,doReportOnWrite)
        end
      else
        begin
          InBufPtr  := LZRWBufSize;
          InBufSize := LZRWBufSize;
          OutBufPtr := 0;
          FillChar(BinaryTree^.TextBuf, SizeOf(TLZTextBuf), 0);
          Seek(InFile, SizeOf(TLZHeader));
          Decompressing := True;
          LZDecode;
          LZDecompress := aWrite
        end

    finally
      { set date/time stamp }
      FileSetDate(TFileRec(OutFile).Handle, f.fTime);
      CloseFile(OutFile);
      if Assigned(aProc) then
        begin
          RepRec.Names := '';
          aProc(RepRec, -2)
        end
    end

  finally
    CloseFile(InFile)
  end
  finally
    LZDone
  end;
{$else}
  Assign(OutFile, Dest);
  Rewrite(OutFile, 1);
  if IOResult <> 0 then
    LZDecompress := -13  {can't open target}
  else begin

  {//////////}
  if Assigned(aProc) then aProc(RepRec, -1);
  LZReportProc := aProc;
  {//////////}
  if not IsComp{IsMyLZFile(InFile, f)} then
    begin {normal copy}
      f.fTime := hT{lFTime(InFile)};
      LZDecompress := MyFCopy(InFile,OutFile,
                              LZ_UNKNOWN_LENGTH,doReportOnWrite)
    end
  {//////////}
  else
    begin
      InBufPtr  := LZRWBufSize;
      InBufSize := LZRWBufSize;
      OutBufPtr := 0;
      FillChar(BinaryTree^.TextBuf, SizeOf(TLZTextBuf), 0);
      Seek(InFile, SizeOf(TLZHeader));
      Decompressing := True;
      LZDecode;
      LZDecompress := aWrite
    end;

{ set date/time stamp }
{$ifdef Delphi}
  FileSetDate(TFileRec(OutFile).Handle, f.fTime);
{$else}
  SetFTime(OutFile, f.fTime);
{$endif}
  Close(OutFile);if IOResult<>0 then;
  if Assigned(aProc) then
    begin
      RepRec.Names := '';
      aProc(RepRec, -2)
    end
  end; { IOResult = 0 }

  Close(InFile); if IOResult<>0 then;
  end { IOResult = 0 }

  end;
  LZDone
{$endif}
End; { LZDecompress }

{/////////////////////////////////////////////////////////}

Function IsChiefLZFile(const fName: {$ifdef Win32} string
                                    {$else}        PChar
                                    {$endif}):boolean;
{$ifdef aDLL} {$ifdef Win32} stdcall
              {$else Win32}  export
              {$endif Win32};
{$endif aDLL}

Var
h:TLZHeader;
f:file;
{$ifndef Win32}
OldFMode: byte;
{$endif}
Begin
  {$ifdef Win32}
    AssignFile(f, fName);
    FileMode := fmOpenRead; { Win32 only allows 0 <= FileMode <= 2     }
    Reset(f,1);             { However, share access is FILE_SHARE_READ }
    try
      Result := IsMyLZFile(f,h)
    finally
      CloseFile(f)
    end
  {$else}
    IsChiefLZFile := False;
    Assign(f, StrPas(fName));
    OldFMode := FileMode;
{
  Open file: we need Read-access, don't need Write-access and *INSIST*
  that no one else can write to it (i.e. corrupt it) 'til we're done ...
}
    FileMode := (fmOpenRead or fmShareDenyWrite);
    Reset(f,1);
    FileMode := OldFMode;
    if IOResult=0 then
      begin
        IsChiefLZFile := IsMyLZFile(f,h);
        Close(f) { ReadOnly Reset() succeeded; Close() MUST succeed }
      end
  {$endif}
end;
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
Function ArchiveSquash(Var InFile, OutFile: file;
                       Const aProc: TLZReportProc):LongInt;
Begin
  ArchiveSquash := -1;
  if IsLZInitialized then
  begin
    Seek(InFile, 0);{$ifndef Win32} if IOResult<>0 then; {$endif}

    LZReportProc := aProc;
    InBufPtr     := LZRWBufSize;
    InBufSize    := LZRWBufSize;
    OutBufPtr    := 0;
    Height       := 0;
    MatchPos     := 0;
    MatchLen     := 0;
    LastLen      := 0;
    aWrite       := 0;

    FillChar(BinaryTree^, SizeOf(TBinaryTree), 0);
    FillChar(CodeBuf, SizeOf(CodeBuf), 0);
    Decompressing := False;
    LZEncode;
    ArchiveSquash := aWrite
  end; {IsLZInitialized}
End; { ArchiveSquash }

{/////////////////////////////////////////////////////////}
Function IsFileInDir({$ifdef Delphi} const {$endif} fSpec:String):Boolean;
Var
{$ifdef Windows}
 Dir:TSearchRec;
{$else}
 Dir:SearchRec;
{$endif Windows}
Begin
   {$ifdef Delphi}
     Result := (FindFirst(fSpec, faAnyFile-faDirectory-faVolumeID, Dir)=0);
     if Result then
       SysUtils.FindClose(Dir);
   {$else Delphi}

   {$ifdef Windows}
     FindFirst(Str2PChar(fSpec), faAnyFile-faDirectory-faVolumeID, Dir);
   {$else Windows}
     FindFirst(fSpec,AnyFile-Directory-VolumeID, Dir);
   {$endif Windows}
     IsFileInDir := (DosError = 0)

    {$endif Delphi}
End;

{//////////////////////////////////////////}
Procedure InitReportRec(Var RepRec:TLZReportRec; Const X:TLZBigFileRec);
Begin
   With RepRec, X do
     begin
       Names := BigNames;
       Sizes := BigSizes;
       uSizes:= uBigSizes;
       Times := BigTimes;
       FileVersion := BigFileVersion;
       IsDir := IsBigDir
    end
End;

{/////////////////////////////////////////////////////////}
Function LZArchive(const fSpec, ArchName: {$ifdef Win32} string
                                          {$else}        PChar
                                          {$endif};
                   LZRecurseDirs: TLZRecurse;
                   aProc:         TLZReportProc):LongInt;
{$ifdef aDLL} {$ifdef Win32} stdcall
              {$else Win32}  export
              {$endif Win32};
{$endif aDLL}

type
  PDirTimes = ^TDirTimes;
  TDirTimes = array[1..MaxChiefLZDirectories] of LongInt;

Const
{$ifdef Windows}
  faFiles = faReadOnly+faSysFile+faHidden+faArchive+0;
  faDirs  = faSysFile+faHidden+faDirectory+0;
{$else Windows}
  faFiles = ReadOnly+SysFile+Hidden+Archive+0;
  faDirs  = SysFile+Hidden+Directory+0;
{$endif Windows}

VAR
{$ifdef Windows}
 Dir:  TSearchRec;
{$else Windows}
 Dir:  SearchRec;
{$endif Windows}

{$ifndef Win32}
OldFMode   : byte;
Temp       : TLZPathStr;
l, LZTot   : LongInt;
{$endif Win32}

Path,
s1, s2     : TLZPathStr;
fSpecName  : TLZPathStr;
i          : LongInt;
t          : Text;
UseFile    : boolean;
Hed        : TLZArchiveHeader;
FoundName  : TLZPathStr;
MemRec,
DirCount,
DirCountEx : TLZSSWord;
DirArray   : PLZDirArray;
DirTimes   : PDirTimes;
PIndex     : LongInt;
NewPIndex  : LongInt;
RepRec     : TLZReportRec;

begin
{$ifdef aDLL}
  if IsLZInitialized then
  {$ifdef Win32}
    RaiseError(EChiefLZDLL,SBusyChief);
  {$else}
    begin
      LZArchive := -20; {busy}
      Exit
    end
  {$endif};
 {$endif aDLL}

  if not LZInit then
  {$ifdef Win32}
    RaiseError(EChiefLZError,SInitFailed);
  {$else}
    begin
      LZArchive := -10; {init error}
      Exit
    end;
  {$endif}

 {$ifdef Win32}
  try { finally }
 {$endif}

  s1:= {$ifdef Win32} fSpec
       {$else}        StrPas(fSpec)
       {$endif};
  s2:= {$ifdef Win32} ExpandFileName(ArchName)
       {$else}        StrPas(ArchName)
       {$endif};

 {are we reading from a file?}
  UseFile := False;
  i := Pos('/F=', Uppercase(s1));
  If i > 0 then
    begin
      Delete(s1, 1, i+2);
      UseFile := True;
      LZRecurseDirs := LZNoRecurse
    end;

  if (Length(s1)=0) or (Length(s2)=0) then
  {$ifdef Win32}
    RaiseError(EChiefLZError,SInvalidParams);
  {$else}
    begin
      LZDone;
      Exit
    end;
  {$endif}

{$ifdef Win32}

  s1 := ExpandFileName(s1);
  if AnsiCompareText(s1,s2) = 0 then
    RaiseErrorStr(EChiefLZArchive,SSameFileName,s1);

  AssignFile(OutFile, s2);
  Rewrite(OutFile, 1);
  try { finally }
    Result := 0;

    New(jR);
    try { finally }
      Hed.Count := 0;
      DirCount := 0;

    { get the filenames for the archive }
      if UseFile then { - use a LIST file }
        begin
          Path := '';
          AssignFile(t, s1);
          Reset(t);
          try { finally }
            while not EOF(t) do
              begin
                Readln(t,s1);
                if (Length(s1)<>0) and
                   (AnsiCompareText(s1,s2) <> 0) and
                    FileExists(s1) then
                  begin
                  {$IFDEF Debug}
                    if Hed.Count > MaxChiefLZArchiveSize then
                      raise EChiefLZDebug.Create('Too many archive files');
                  {$ENDIF}
                    if Hed.Count >= MaxChiefLZArchiveSize then
                      break;
                    inc(Hed.Count);
                    with jr^[Hed.Count] do
                      begin
                        IsBigDir := False;
                        BigDirID := 0;
                        BigCompressed := True;
                        uBigSizes := fSize(s1);
                        BigTimes := sfTime(s1);
                        BigFileVersion := GetFileVersion(s1);
                        BigNames := s1
                      end
                  end {s1 <> s2}
              end; {not EOF(t)}
            if Hed.Count = 0 then
              RaiseError(EChiefLZArchive, SNoValidFileName)
          finally
            CloseFile(t)
          end
        end
{
  We do not have a LIST file, so find filespecs ...
}
        else
          begin
            Path := ExtractFilePath(s1);
            fSpecName := ExtractFileName(s1);
            New(DirArray);
            try {finally}
              DirArray^[0] := Path;

              if LZRecurseDirs <> LZNoRecurse then
{
  `Recurse' through subdirectories for files matching the given mask.
  There are 2 levels of recursion - full recursion and immediate-subdirs...
}
              begin
                New(DirTimes);
                try {finally}

                  i := 0;
                  repeat
                    if (LZRecurseDirs <> LZNoRecurse) and
                       (FindFirst(DirArray^[i]+'*', faDirs, Dir) = 0) then
                    try {finally}
                      repeat
                        if Dir.Attr and faDirectory <> 0 then
                          begin
                            FoundName := GetFoundFileName(Dir);
                            if (FoundName <> '.') and
                               (FoundName <> '..') then
                              begin
                              {$IFDEF Debug}
                                if DirCount > MaxChiefLZDirectories then
                                  raise EChiefLZDebug.Create('DirArray^ bounds exceeded');
                              {$ENDIF}
                                if DirCount >= MaxChiefLZDirectories then
                                  break;
                                inc(DirCount);
                                DirArray^[DirCount] :=
                                                    DirArray^[i]+FoundName+'\';
                                DirTimes^[DirCount] := Dir.Time
                              end
                          end
                      until FindNext(Dir) <> 0
                    finally
                      SysUtils.FindClose(Dir)
                    end;

                    if i = 0 then
                      begin
                        Inc(i);
{
            Turn directory-recursion off - have only looked in
            immediate subdirectories ...
}
                        if LZRecurseDirs = LZRecurseOnce then
                          Dec(LZRecurseDirs)
                      end
                    else if not IsFileInDir(DirArray^[i]+fSpecName) then
                      begin
                        DirArray^[i] := '';  { Destroy string ... }
                        Move(DirArray^[i+1],
                             DirArray^[i],
                            (DirCount-i)*SizeOf(DirArray^[0]));
                        Move(DirTimes^[i+1],
                             DirTimes^[i],
                            (DirCount-i)*SizeOf(DirTimes^[1]));
{
  I think I'm messing too deeply with long strings here... If I am correct,
  then I need to set the element DirArray[DirCount] to be an empty string
  WITHOUT TAMPERING WITH THE REFERENCE COUNTS !!! I.e. the element must be
  typecast to a pointer and set to nil...
}
                        Pointer(DirArray[DirCount]) := nil;
                        Dec(DirCount)
                      end
                    else
                      begin
                        Inc(Hed.Count);
                        with jr^[Hed.Count] do
                          begin
                            IsBigDir  := True;
                            BigDirID  := i;
                            BigTimes  := DirTimes^[i];
{
  These two fields irrelevant for directories ...
}
                            BigSizes  := 0;
                            uBigSizes := 0;
{}
                            BigFileVersion := '-';
                            BigNames  := RemoveBackSlash(DirArray^[i])
                          end;
                        Inc(i)
                      end

                  until i > DirCount

                finally
                  Dispose(DirTimes)
                end;
{
  Find the parents for each directory ...
}
                DirCountEx := DirCount;
                for i := 1 to DirCount do
                  begin
{
  Search for a hole in the directory structure ...
}
                    FoundName :=
                            ExtractFilePath(RemoveBackSlash(DirArray^[i]));
                    PIndex := GetDirIndex(FoundName,DirArray,DirCountEx);
{
  If such a hole exists, we must store headers for all the missing
  directories between Path and FoundName WORKING FORWARDS, or we'll
  give some of the directories the wrong parents ...
}
                    if PIndex < 0 then
                      begin
                        PIndex := 0;
                        s1 := Path;
                        repeat
                          s1 := FirstDirectoryBetween(s1,FoundName);
                          NewPIndex := GetDirIndex(s1,DirArray,DirCountEx);
                          if NewPIndex < 0 then
                            begin
{
  Do we have room for another directory ... ?
}
                            {$IFDEF Debug}
                              if DirCountEx > MaxChiefLZDirectories then
                                raise EChiefLZDebug.Create('Too many ChiefLZ directories.');
                            {$ENDIF}
                              if DirCountEx >= MaxChiefLZDirectories then
                                Break;

                              inc(DirCountEx);
                              DirArray^[DirCountEx] := s1;
                              inc(Hed.Count);
                              with jr^[Hed.Count] do
                                begin
                                  BigNames := RemoveBackSlash(s1);
                                  BigTimes := NulFileDate;
                                  IsBigDir := True;
                                  BigDirID := DirCountEx;
                                  BigParentDir := PIndex;
{
  These fields irrelevant for directories ...
}
                                  BigSizes  := 0;
                                  uBigSizes := 0;
{}
                                  BigFileVersion := '-'
                                end;
                              NewPIndex := DirCountEx
                            end;
                          PIndex := NewPIndex
                        until Length(s1) = Length(FoundName)
                      end; {PIndex < 0}
{
  Now we're sure it exists, store Parent-index for directory i ...
}
                    jr^[i].BigParentDir := PIndex

                  end { 1 <= i <= DirCount }
              end; { LZRecurseDirs }
{
   Look through the directory list (only the ones with files in!) and
   create an archive of files from them. Note that DirArray^[0] is
   the Path directory ...
}
              for i := 0 to DirCount do
                if FindFirst(DirArray^[i]+fSpecName, faFiles, Dir) = 0 then
                  try { finally }
                    repeat
                      s1 := DirArray^[i] + GetFoundFileName(Dir);
                    {$IFDEF Debug}
                    { Did not put faDirectory in Attr mask, so
                      **shouldn't** see any directories ...   }
                      if Dir.Attr and faDirectory <> 0 then
                        raise EChiefLZDebug.Create('Found directory when expecting file');
                    {$ENDIF}
{
  Check that we are not trying to archive the output file ...
}
                      if AnsiCompareText(s1,s2) <> 0 then
                        begin
                        {$IFDEF Debug}
                          if Hed.Count > MaxChiefLZArchiveSize then
                            raise EChiefLZDebug.Create('Max archive size exceeded.');
                        {$ENDIF}
                          if Hed.Count >= MaxChiefLZArchiveSize then
                            Break;
                          inc(Hed.Count);
                          with jr^[Hed.Count] do
                            begin
                              IsBigDir  := False;
                              BigDirID  := i;
                              BigCompressed := True;
                              uBigSizes := Dir.Size;
                              BigSizes  := Dir.Size;
                              BigTimes  := Dir.Time;
                              BigNames  := s1;
                              BigFileVersion := GetFileVersion(s1);
                            end
                        end
                    until FindNext(Dir) <> 0
                  finally
                    SysUtils.FindClose(Dir)
                  end

            finally
              Dispose(DirArray)
            end
          end;

        Hed.Signature := MyLZSignature;
        MemRec := SizeOf(TLZFileRec)*Hed.Count + SizeOf(TLZCount);

        {fix the header}
        GetMem(jr2, MemRec);
        try { finally }

          FillChar(jr2^, MemRec, 0);
          jr2^.Count := Hed.Count;
          for i := 1 to Hed.Count do
            with jr2^.Files[i], jr^[i] do
              begin
                IsDir  := IsBigDir;
                DirID  := BigDirID;
                ParentDir := BigParentDir;
                Compressed := BigCompressed;
                Sizes  := BigSizes;
                uSizes := uBigSizes;
                Times  := BigTimes;
                FileVersion := BigFileVersion;
                Names  := ExtractFileName(BigNames)
              end;
        { write the header }
          BlockWrite(OutFile, Hed.Signature, SizeOf(Hed.Signature));
                                                     {main header}
          BlockWrite(OutFile, jr2^, MemRec);         {file headers}

        { loop through each file }
          for i := 1+DirCount to Hed.Count do
            with jr^[i] do
              begin
                AssignFile(InFile,BigNames);
                InitReportRec(RepRec, jr^[i]);
                BlankRec := RepRec;

                FileMode := fmOpenRead; { Win32 only allows 0 <= FileMode <= 2 }
              {$I-}                     { However, share access is FILE_SHARE_READ }
                Reset(InFile, 1);
              {$I+}
                if IOResult <> 0 then    { Exception block generates   }
                  with jr2^.Files[i] do  { false compiler warning ...  }
                    begin                { Handle error using IOResult }
                      Sizes  := 0;
                      uSizes := 0;
                      Compressed := False;
                      Continue
                    end;

                try { finally }
               { report procedure }
                  inc(Result);
                  if Assigned(aProc) then aProc(RepRec,-1);
                  LZReportProc := aProc;
                  with jr2^.Files[i] do
                    if IsChiefLZFile(BigNames) or
                       IsChiefLZArchive(BigNames) then
                 { Just copy (compressed) file into archive ... }
                      begin
                        Sizes := MyFCopy(InFile,OutFile,
                                         LZ_UNKNOWN_LENGTH,doReportOnRead);
                        Compressed := False
                      end
                    else
                 { Compress the file into the archive ... }
                      Sizes := ArchiveSquash(InFile, OutFile, aProc)
                finally
                  CloseFile(InFile);
                  if Assigned(aProc) then
                    begin
                      RepRec.Names := '';
                      aProc(RepRec,-2)
                    end
                end
              end; { 1+DirCount <= i <= Count }

        { write header again }
          Seek(OutFile, SizeOf(Hed.Signature));
          BlockWrite(OutFile, jr2^, MemRec); {file headers}

        finally
          FreeMem(jr2, MemRec)
        end

    finally
      Dispose(jr)
    end

  finally
    CloseFile(OutFile)
  end
  finally
    LZDone
  end;
{$else}

  {find path to add to filenames}
   Path := '';
   if not UseFile then
     Path := ExtractFilePath(s1);

   if Length(Path) = 0 then
     GetDir(0, Path);
   Path := AddBackSlash(Uppercase(Path));

   if Length(ExtractFilePath(s2)) = 0 then
     Insert(AddBackSlash(GetCurrentDir),s2,1);

   if Length(ExtractFilePath(s1)) = 0 then
     Insert(Path,s1,1);

   s2 := Uppercase(s2);
   {s1=filespec; s2=archive file}

   if Uppercase(s1) <> s2
   then begin

   Assign(OutFile, s2);
   Rewrite(OutFile, 1);
   If IOResult<>0 then
     LZArchive := -11 {write error}
   else begin

   New(jR);
   if jr = nil then
   {
     Error condition ... ???
   }
   else begin

   LZArchive := 0; {no file}
   Hed.Count := 0;
   DirCount  := 0;

   {get the file names for the archive}
   If UseFile then BEGIN {using a LIST file}
      Assign(t, s1);
      Reset(t);
      If IOResult<>0 then begin
         LZArchive := -13; {LIST file does not exist}
         Dispose(jr);
         Close(OutFile); if IOResult<>0 then;
         LZDone;
         Exit
      end;
      While not EOF(t) do begin
        Readln(t, s1);
        s1 := Uppercase(s1);
        if (IOResult=0) and (Length(s1)>0)
            and (s1 <> s2)
            and FileExists(s1) then
          begin
          {$IFDEF Debug}
            if Hed.Count > MaxChiefLZArchiveSize then
              RunErrorMessage('Max ChiefLZ archive size exceeded.');
          {$ENDIF}
            if Hed.Count >= MaxChiefLZArchiveSize then
              Break;
            inc(Hed.Count);
            with jr^[Hed.Count] do
              begin
                IsBigDir  := False;
                BigDirID  := 0;
                BigCompressed := True;
                uBigSizes := fSize(s1);
                BigTimes  := sfTime(s1);
                BigNames  := s1;
                BigFileVersion := GetFileVersion(s1);
              end
          end {s1<>s2}
      end; {while not eof(t)}

      Close(t);if IOResult<>0 then;

      if (Hed.Count = 0) then begin {no file}
         LZArchive := -14; {no valid file in LIST file}
         Dispose(jr);
         Close(OutFile); if IOResult<>0 then;
         LZDone;
         Exit
      end;
   END
{
  We do not have a LIST file, so find fileSpecs ...
}
   else
     begin
       fSpecName := ExtractFileName(s1);
       New(DirArray);
       if DirArray <> nil then
       begin
         DirCountEx := 0;
         DirArray^[0] := @Path;  { REMEMBER - Path is NOT on the Heap! }

         if LZRecurseDirs <> LZNoRecurse then
{
  `Recurse' through subdirectories for files matching the given mask.
  There are 2 levels of recursion - full recursion and immediate-subdirs...
}
         begin
           New(DirTimes);
           if DirTimes <> nil then
           begin

             i := 0;
             repeat
               if LZRecurseDirs <> LZNoRecurse then
               begin
             {$ifdef Delphi}
               if FindFirst(DirArray^[i]^+'*.*',faDirs,Dir) = 0 then
               begin
             {$else}
             {$ifdef Windows}
               Temp := DirArray^[i]^+'*.*';
               FindFirst(Str2PChar(Temp),faDirs,Dir);
             {$else Windows}
               FindFirst(DirArray^[i]^+'*.*',faDirs,Dir);
             {$endif Windows}
               if DosError = 0 then
             {$endif}
               repeat
               {$ifdef TPW}
                 FoundName := StrPas(Dir.Name);
               {$endif TPW}
                 if (Dir.Attr and {$ifdef Windows} faDirectory
                                  {$else}          Directory
                                  {$endif} <> 0) and
                  {$ifdef TPW}
                    (FoundName <> '.') and (FoundName <> '..')
                  {$else TPW}
                    (Dir.Name <> '.') and (Dir.Name <> '..')
                  {$Endif TPW}

                 then
                 begin
                 {$IFDEF Debug}
                   if DirCount > MaxChiefLZDirectories then
                     RunErrorMessage('DirArray^ bounds exceeded.');
                 {$ENDIF}
                   if DirCount >= MaxChiefLZDirectories then
                     break;
                   inc(DirCount);
                   {
                   writeln(DirCount,'=',Dir.Name);
                   }
                   DirTimes^[DirCount] := Dir.Time;

                   {$ifdef TPW}
                     DirArray^[DirCount] := NewString(DirArray^[i]^+FoundName+'\');
                   {$else TPW}
                     DirArray^[DirCount] := NewString(DirArray^[i]^+Dir.Name+'\');
                   {$endif TPW}

                   if DirArray^[DirCount] = nil then
                   {
                     Error condition ...
                   };
                 end;
             {$ifdef Delphi}
               until FindNext(Dir) <> 0;
               SysUtils.FindClose(Dir)
               end;
             {$else}
                 FindNext(Dir)
               until DosError <> 0;
             {$endif}
               end;

               if i = 0 then
                 begin
                   Inc(i);
{
            Turn directory-recursion off - have only looked in
            immediate subdirectories ...
}
                   if LZRecurseDirs = LZRecurseOnce then
                     Dec(LZRecurseDirs)
                 end

               else if not IsFileInDir(DirArray^[i]^+fSpecName) then
                 begin
                   DisposeString(DirArray^[i]);
                   Move(DirArray^[i+1],DirArray^[i],
                                              (DirCount-i)*SizeOf(PString));
                   Move(DirTimes^[i+1],DirTimes^[i],
                                              (DirCount-i)*SizeOf(LongInt));
                   DirArray^[DirCount] := nil;
                   Dec(DirCount)
                 end

               else
                 begin
                   Inc(Hed.Count);
                   with jr^[Hed.Count] do
                     begin
                       IsBigDir  := True;
                       BigDirID  := i;
                       BigCompressed := False;
                       uBigSizes := 0;
                       BigSizes  := 0;
                       BigTimes  := DirTimes^[i];
                       BigFileVersion := '-';
                       BigNames  := RemoveBackSlash(DirArray^[i]^)
                     end;
                   Inc(i)
                 end;

             until i > DirCount;

             Dispose(DirTimes)
           end; {DirTimes <> nil}
{
  Find the parents for each directory ...
}
         DirCountEx := DirCount;
         for i := 1 to DirCount do
           begin
{
  Search for a hole in the directory structure ...
}
             FoundName := ExtractFilePath(RemoveBackSlash(DirArray^[i]^));
             PIndex := GetDirIndex(FoundName, DirArray, DirCountEx);
{
  If such a hole exists, we must store headers for all the missing
  directories between Path and FoundName WORKING FORWARDS, or we'll
  give some of the directories the wrong parents ...
}
             if PIndex < 0 then
               begin
                 PIndex := 0;
                 s1 := Path;
                 repeat
                   s1 := FirstDirectoryBetween(s1,FoundName);

                   NewPIndex := GetDirIndex(s1,DirArray,DirCountEx);
                   if NewPIndex < 0 then
                     begin
{
  Do we have room for another directory ... ?
}
                     {$IFDEF Debug}
                       if DirCountEx > MaxChiefLZDirectories then
                         RunErrorMessage('Too many ChiefLZ directories.');
                     {$ENDIF}
                       if DirCountEx >= MaxChiefLZDirectories then
                         Break;

                       inc(DirCountEx);
                       DirArray^[DirCountEx] := NewString(s1);
                       inc(Hed.Count);
                       with jr^[Hed.Count] do
                         begin
                           BigNames := RemoveBackSlash(s1);
                           BigTimes := NulFileDate;
                           IsBigDir := True;
                           BigDirID := DirCountEx;
                           BigParentDir := PIndex;
                           BigSizes  := 0;
                           uBigSizes := 0;
                           BigFileVersion := '-';
                         end;
                       NewPIndex := DirCountEx
                     end;
                   PIndex := NewPIndex
                 until Length(s1) = Length(FoundName)
               end; { PIndex < 0 }
{
  Now we're sure it exists, store Parent-index for directory i ...
}
             jr^[i].BigParentDir := PIndex

           end { 1 <= i <= DirCount }

         end; { LZRecurseDirs }
{
  Look through the directory list and create an archive of files from them...
  Note that DirArray[0]^ is the Path directory ...
}
         for i := 0 to DirCount do
         begin
         {$ifdef Delphi}
           if FindFirst(DirArray^[i]^+fSpecName,faFiles,Dir) = 0 then
         {$else Delphi}
         {$ifdef Windows}
           Temp := DirArray^[i]^+fSpecName;
           FindFirst(Str2PChar(Temp),faFiles,Dir);
         {$else Windows}
           FindFirst(DirArray^[i]^+fSpecName,faFiles,Dir);
         {$endif Windows}
           if DosError = 0 then
         {$endif Delphi}
           repeat
           {$ifdef TPW}
             s1 := DirArray^[i]^+StrPas(Dir.Name);
           {$else TPW}
             s1 := DirArray^[i]^+Dir.Name;
           {$endif TPW}

           {$IFDEF Debug}
           { Did not put faDirectory in Attr mask, so *shouldn't*
             see any directories ... }
             if Dir.Attr and {$ifdef Windows} faDirectory
                             {$else}          Directory
                             {$endif} <> 0 then
               RunErrorMessage('Found directory when expecting file');
           {$ENDIF}
{
  Check that we are not trying to archive the output file ...
}
             if Uppercase(s1) <> s2 then
             begin
             {$IFDEF Debug}
               if Hed.Count > MaxChiefLZArchiveSize then
                 RunErrorMessage('Max archive size exceeded');
             {$ENDIF}
               if Hed.Count >= MaxChiefLZArchiveSize then
                 Break;
               inc(Hed.Count);
               with jr^[Hed.Count] do
                 begin
                   IsBigDir      := False;
                   BigDirID      := i;
                   BigCompressed := True;
                   uBigSizes     := Dir.Size;
                   BigSizes      := Dir.Size;
                   BigTimes      := Dir.Time;
                   BigNames      := s1;
                   BigFileVersion := GetFileVersion(s1);
                 end
             end;
         {$ifdef Delphi}
           until FindNext(Dir) <> 0;
           SysUtils.FindClose(Dir);
         {$else Delphi}
             FindNext(Dir);
           until DosError <> 0;
         {$endif Delphi}
         end;

         for i := 1 to DirCountEx do
           DisposeString(DirArray^[i]);
         Dispose(DirArray)

       end; { DirArray <> nil }
     end; { NOT UseFile }

   Hed.Signature := MyLZSignature;
   MemRec := SizeOf(TLZFileRec)*Hed.Count + SizeOf(TLZCount);

   {fix the header}
   GetMem(jr2, MemRec);
   if jr2 = nil then
   {
     Error condition ...???
   };
   FillChar(jr2^, MemRec, #0);
   jr2^.Count := Hed.Count;
   for i := 1 to Hed.Count do
     with jr2^.Files[i], jr^[i] do
       begin
         IsDir  := IsBigDir;
         DirID  := BigDirID;
         ParentDir := BigParentDir;
         Compressed := BigCompressed;
         Sizes  := BigSizes;
         uSizes := uBigSizes;
         Times  := BigTimes;
         FileVersion := BigFileVersion;
         Names  := ExtractFileName(BigNames);
       end;

  {write the header}
  BlockWrite(OutFile, Hed.Signature, SizeOf(Hed.Signature)); {main header}
  BlockWrite(OutFile, jr2^, MemRec); {file headers}
  If IOResult<>0 then
    LZArchive := -12 {header write error}
  else begin

  LZArchive := -13; {other write error}
  LZTot := 0;

  {loop through each file}
  for i := 1+DirCount to Hed.Count do
    with jr^[i] do
      begin
        InitReportRec(RepRec, jr^[i]);
        BlankRec := RepRec;
        Assign(InFile, BigNames);
        OldFMode := FileMode;
{
  This choice of FileMode will cause Reset() to fail unless LZArchive
  has *EXCLUSIVE WRITE-ACCESS* to the file. This is what we want, as
  otherwise the file might change midway through the archive process.
}
        FileMode := (fmOpenRead or fmShareDenyWrite);
        Reset(InFile, 1);
        FileMode := OldFMode;
        if IOResult <> 0 then
          with jr2^.Files[i] do
            begin                { Could not open file- insert nul }
              Sizes  := 0;       { entry into the LZ-Archive.      }
              uSizes := 0;
              Compressed := False;
              Continue
            end;

       {report procedure }
        if Assigned(aProc) then aProc(RepRec, -1);

        inc(LZTot);
        LZReportProc := aProc;

        with jr2^.Files[i] do
          begin
            if (IsChiefLZArchive(Str2PChar(BigNames)))
              or (IsChiefLZFile(Str2PChar(BigNames))) then
              begin
                l := MyFCopy(InFile,OutFile,
                              LZ_UNKNOWN_LENGTH,doReportOnRead);
                Compressed := False
              end
            else
              l := ArchiveSquash(InFile, OutFile, aProc);
            Sizes := l
          end{with jr2^};

        Close(InFile);if IOResult<>0 then;
        if Assigned(aPRoc) then
          begin
            RepRec.Names := '';
            aProc(RepRec, -2)
          end
      end; {With jr^, DirCount+1 <= i <= Count}

   LZArchive := LZTot;

   {rewrite header again}
   Seek(OutFile, SizeOf(Hed.Signature));
   BlockWrite(OutFile, jr2^, MemRec); {file headers}
   end;

   FreeMem(jr2, MemRec);

   Dispose(jr);
   end; { jr <> nil }

   Close(OutFile);if IOResult<>0 then;
   end; { IOResult = 0 }
   end; { Uppercase(s1) = s2 }
   LZDone;
{$endif}
End;

{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
Function LZDearchive(ArchName: {$ifdef Win32} string
                               {$else}        PChar
                               {$endif};
                    {$ifdef Win32} DefDir: string
                    {$else} const aDefDir: PChar
                    {$endif};
                     LZQuestion: TLZQuestionFunc;
                     aProc:      TLZReportProc;
                     aRename:    TLZRenameFunc):LongInt;
{$ifdef aDLL} {$ifdef Win32} stdcall
              {$else Win32}  export
              {$endif Win32};
{$endif aDLL}
{
  Local function to determine user's request ...
}
function UserRequestsRename(var FName: TLZPathStr): boolean;
var
  Path,
  TempName: string;
{$ifndef Delphi}
  Result:   boolean;
{$endif}
begin
  if not Assigned(aRename) then
    UserRequestsRename := False
  else
    begin
      TempName := FName;
      Path := ExtractFilePath(TempName);
      repeat
        Result := aRename(TempName);
        if not Result then
        {$ifdef Delphi}
          Exit;
        {$else}
          begin
            UserRequestsRename := false;
            Exit
          end;
        {$endif}
         if Length(ExtractFilePath(TempName)) = 0 then
           Insert(Path,TempName,1)
       {$ifdef Delphi}
         else
           TempName := ExpandFileName(TempName)
       {$endif}
      until not FileExists(TempName);
      FName := TempName;
    {$ifndef Delphi}
      UserRequestsRename := Result
    {$endif}
    end
end;

VAR
SrcFile,
DestFile:file;
TempFile:file;

LZFilePos: LongInt;
f        : TLZHeader;
RepRec   : TLZReportRec;
BigMemRec,
MemRec   : TLZSSWord;
Hed      : TLZArchiveHeader;
i        : Integer;

{$ifdef Win32}
TempName: string;
{$else}
BRead   : Integer;
OldFMode: byte;
Total   : LongInt;
TempName,
DefDir,Source: string[128];
{$endif}
DirArray: PLZDirArray;
DirCount: Integer;

begin
   {$ifdef aDLL}
     if IsLZInitialized then
     {$ifdef Win32}
       RaiseError(EChiefLZDLL,SBusyChief);
     {$else}
       begin
         LZDearchive := -20; {busy}
         Exit
       end;
     {$endif}
   {$endif aDLL}

   if not IsChiefLZArchive(ArchName) then
   {$ifdef Win32}
     RaiseErrorStr(EChiefLZArchive,SInvalidArchive,ArchName);
   {$else}
     begin
       LZDearchive := -30; {bad archive}
       Exit
     end;
   {$endif}

   {$ifdef Win32}

   {target directory}
   if Length(DefDir) = 0 then
     GetDir(0,DefDir)  // This directory MUST exist!
   else
     begin
       DefDir := ExpandFileName(DefDir);
       if not DirectoryExists(DefDir) then
         try
           MkDir(DefDir)
         except
           RaiseErrorStr(EChiefLZArchive,SBadDirectory,DefDir)
         end              // Delphi will never return from RaiseErrorStr()
     end;

   DefDir := AddBackSlash(DefDir);

   {source file}
   ArchName := ExpandFileName(ArchName);

   AssignFile(SrcFile, ArchName);
   FileMode := fmOpenRead; { Win32 only allows 0 <= FileMode <= 2 }
   Reset(SrcFile, 1);      { However, share access is FILE_SHARE_READ }
   try { finally }

     BlockRead(SrcFile, Hed, SizeOf(Hed));
     Result := Hed.Count;
     MemRec := SizeOf(TLZFileRec)*Hed.Count + SizeOf(TLZCount);
     BigMemRec := SizeOf(TLZBigFileRec)*Hed.Count;
     GetMem(jr, BigMemRec);
     try { except }
       Initialize(jr^[1], Hed.Count); { jr^ contains long strings...!!! }
       try { finally }

         GetMem(jr2, MemRec);
         try { finally }
           BlockRead(SrcFile, jr2^.Files[1], MemRec-SizeOf(TLZCount));
           jr2^.Count := Hed.Count;

           New(DirArray);
           try { finally }

             DirCount := 0;
             DirArray^[0] := DefDir;
             try { except }
               for i := 1 to Hed.Count do
                 with jr^[i], jr2^.Files[i] do
                   begin
{
  IMPORTANT POINT: This algorithm depends on having all of the directory entries
  listed BEFORE the file entries in the archive header ...
}
                     if IsDir then
                       begin
                         inc(DirCount);
                         BigNames := DefDir + GetFullLZName(jr2^,i);
                         CreatePath(BigNames);
                     { report directory creation using archive entry info }
                         if Assigned(aProc) then
                           begin
                             InitReportRec(RepRec, jr^[i]);
                             aProc(RepRec, -1);
                             RepRec.Names := '';
                             aProc(RepRec, -2)
                           end;
                         DirArray^[i] := BigNames + '\'
                       end
                     else
                       BigNames := DirArray^[DirID] + Names;

                     IsBigDir  := IsDir;
                     BigDirID  := DirID;
                     BigParentDir := ParentDir;
                     BigCompressed := Compressed;
                     BigSizes  := Sizes;
                     uBigSizes := uSizes;
                     BigTimes  := Times;
                     BigFileVersion := FileVersion

                   end {with jr^}
             except
               on EInOutError do
                 RaiseErrorStr(EChiefLZArchive,SBadDirectory,DirArray^[DirCount])
             end

           finally
             Dispose(DirArray)
           end
         finally
           FreeMem(jr2, MemRec)
         end;

         New(Buf);
         try { finally }
           LZFilePos := FilePos(SrcFile);

         { temp file }
           TempName := GetTempChiefFileName; { This call CREATES a file on disc ... }
           AssignFile(TempFile, TempName);   { ... and this links the file to a Pascal var }
{
   If premature EOF, archive is corrupt... This will trigger
   an exception - handled (and re-raised) below.
}
           for i := 1+DirCount to Hed.Count do
             with jr^[i] do
               begin {normal file - try to extract}
                 InitReportRec(RepRec, jr^[i]); {stuff inside the archive}
                 BlankRec := RepRec;
{
  This file was STORED compressed; just copy it out ...
}
                 if not BigCompressed then
                   begin
{
  ... ensuring this stored LZ file will not overwrite SrcFile ...
}
                     if ( (AnsiCompareText(ArchName,BigNames)<>0)
                            or UserRequestsRename(BigNames) ) then
{
  ...AND checking that the file doesn't already exist ...
}
                       if FileExists(BigNames) and Assigned(LZQuestion) then
                         case LZQuestion(RepRec,BigNames) of
                           LZQuit: begin
                                     LZDearchive := Pred(i);
                                     Break     { User requests Abort!! }
                                   end;
{
  Now the mundane matters - copy out the stored file ...
}
                           LZYes: begin
                                    AssignFile(DestFile, BigNames);
                                    Rewrite(DestFile,1);
                                    try { finally }
                                      if Assigned(aProc) then
                                        aProc(RepRec,-1);
                                      LZReportProc := aProc;
                                      MyFCopy(SrcFile,DestFile,
                                              BigSizes,doReportOnWrite)
                                    finally
                                      CloseFile(DestFile);
                                      if Assigned(aProc) then
                                        aProc(RepRec,-2)
                                    end
                                  end
                         end
                   end
{
  This file was compressed into the archive- it needs expanding ...
}
                 else
                   begin
                     Rewrite(TempFile,1);  // (Re?)open the temp file ... (wiping contents)
                     try { finally }
                      { write header ... }
                       with f do
                         begin
                           Signature := ChiefLZSig;
                           fName     := ExtractFileName(BigNames);
                           uSize     := uBigSizes;
                           cSize     := BigSizes;
                           fTime     := BigTimes;
                           Version   := BigFileVersion
                         end;
                       BlockWrite(TempFile, f, SizeOf(f));
(*
                       j := 0;
                       repeat
                         BRead := Min(BigSizes-j, SizeOf(Buf^));
       { If the file is shorter than it should be, raise IO-Exception }
                         BlockRead(SrcFile, Buf^, BRead);
       { If the output disc runs out of space, raise IO-Exception }
                         BlockWrite(TempFile, Buf^, BRead);
                         inc(j, BRead)
                       until (j >= BigSizes);
*)
                       LZReportProc := nil;
                       MyFCopy(SrcFile, TempFile, BigSizes, doReportOnWrite)

                     finally
                       CloseFile(TempFile)
                     end;

                   { decompress the temporary file ... }
                     try
                       LZDecompress(TempName,BigNames,LZQuestion,aProc)
                     except
                       on EAbort do  { Catch silent exception...    }
                         begin       { -Stop dearchiving files NOW! }
                           LZDearchive := Pred(i);
                           Break
                         end
                     end
                   end;

              { goto location of next file in archive ... }
                 inc(LZFilePos, BigSizes);
                 Seek(SrcFile, LZFilePos)
               end; { 1+DirCount <= i <= Count }

           Erase(TempFile)  // Delete the temporary file ...

         finally
           Dispose(Buf)
         end
       finally
         Finalize(jr^[1], Hed.Count); // jr^ contains long strings ...!
         FreeMem(jr, BigMemRec)
       end
     except
       on E: EInOutError do  // Re-raise the exception as something
         begin               //   more obvious.
           if E.ErrorCode = 100 then  // `Read beyond EOF'
             RaiseErrorStr(EChiefLZArchive,SCorruptArchive,ArchName);
           raise             // Different IO-Error, so re-raise it to next handler
         end
     end
   finally
     CloseFile(SrcFile)
   end

   {$else}

   {target directory}
   DefDir := StrPas(aDefDir);
   if Length(DefDir) = 0 then
     GetDir(0, DefDir)       { This directory MUST exist! }
   else if not DirectoryExists(DefDir) then
     begin
       MkDir(DefDir);
       If IOResult <> 0 then
       begin
         LZDearchive := -31; {bad directory}
         Exit
       end
     end;

   DefDir := AddBackSlash(DefDir);

   TempName := StrPas(ArchName);
   Source := ExtractFilePath(TempName);
   TempName := ExtractFileName(TempName);
   if Length(Source)=0 then
     GetDir(0, Source);
   Source := AddBackSlash(Source) + TempName;

   LZDearchive := -1; {open error}
   Assign(SrcFile, Source{StrPas(ArchName)});
   OldFMode := FileMode;
{
  Open archive file: we require Read-access, don't need Write-access,
  and *INSIST* that no one else can write to it (i.e. corrupt it)
  until we're done ...
}
   FileMode := (fmOpenRead or fmShareDenyWrite);
   Reset(SrcFile, 1);
   FileMode := OldFMode;
   If IOResult = 0 then
   begin

   LZDearchive := -2; {open error}
   BlockRead(SrcFile, Hed, SizeOf(Hed));
   if IOResult = 0 then
   begin

   MemRec := SizeOf(TLZFileRec)*Hed.Count + SizeOf(TLZCount);
   BigMemRec := SizeOf(TLZBigFileRec)*Hed.Count;

   GetMem(jr, BigMemRec);
   if jr = nil then
{
  Error condition ...
}
  else begin

  GetMem(jr2, MemRec);
  if jr2 <> nil then
  begin

   {error reading header}
  BlockRead(SrcFile, jr2^.Files[1], MemRec-SizeOf(TLZCount));
  if IOResult<>0 then begin
     Close(SrcFile); { Reset() Ok; hence Close() must succeed. }
     FreeMem(jr2, MemRec);
     FreeMem(jr, BigMemRec);
     Exit
  end;
  jr2^.Count := Hed.Count;

  DirCount := 0;
  New(DirArray);
  if DirArray <> nil then
  begin

    DirArray^[0] := @DefDir; { This string is NOT on the heap!!! }

    for i := 1 to Hed.Count do
      with jr^[i], jr2^.Files[i] do
        begin

          if IsDir then
            begin
              Inc(DirCount);
              BigNames := DefDir + GetFullLZName(jr2^,i);
              DirArray^[i] := NewString(BigNames+'\')
            end
          else
            BigNames := DirArray^[DirID]^ + Names;

          IsBigDir  := IsDir;
          BigDirId  := DirID;
          BigParentDir := ParentDir;
          BigCompressed := Compressed;
          BigSizes  := Sizes;
          uBigSizes := uSizes;
          BigTimes  := Times;
          BigFileVersion := FileVersion

        end{with jr^[i]};

     for i := 1 to DirCount do
       DisposeString(DirArray^[i]);
     Dispose(DirArray);

  end; {DirArray<>nil}

  FreeMem(jr2, MemRec)
  end; {jr2<>nil}
{
  This code placed here to help reduce the amount of clean-up that must be
  done in case of an error.
}
  for i := 1 to DirCount do
    begin
      if CreatePath(jr^[i].BigNames) < 0 then
        begin
          LZDearchive := -31;
          FreeMem(jr, BigMemRec);
          Close(SrcFile); { Reset() Ok; hence Close() must succeed. }
          Exit
        end;
      if Assigned(aProc) then
      { report directory-creation using archive-entry information }
        begin
          InitReportRec(RepRec, jr^[i]);
          aProc(RepRec, -1);
          RepRec.Names := '';
          aProc(RepRec, -2)
        end
    end;

  LZFilePos := FilePos(SrcFile);
  New(Buf);
  if Buf = nil then
  {
     Error condition ...???
  }
  else begin

  {error processing file}
  LZDearchive := 0;

  {temp file}
{
  Str2PChar() works by appending #0 to string, and then returning address
  of string[1].
}
  TempName := DefDir;
  if not GetTempChiefFileName(Str2PChar(TempName)) then
    TempName := DefDir + 'CHF$$$.$$$'
  else
    TempName[0] := chr(StrLen(@TempName[1])); { adjust length byte }
  Assign(TempFile, TempName);

  for i := DirCount+1 to Hed.Count do
    with jr^[i] do
      begin {normal file - try to extract}
        InitReportRec(RepRec, jr^[i]); { stuff inside the archive }
        BlankRec := RepRec;
{
  This file was STORED compressed; just copy it out ...
}
        if not BigCompressed then
        begin
{
  ... ensuring this stored LZ file will not overwrite SrcFile ...
}
          if ( (Uppercase(Source) <> Uppercase(BigNames)) or
               UserRequestsRename(BigNames) ) then
{
  ...AND checking that the file doesn't already exist ...
}
            if FileExists(BigNames) and Assigned(LZQuestion) then
              case LZQuestion(RepRec,BigNames) of
                LZQuit: begin
                          LZDearchive := Pred(i); { User requested Abort! }
                          Break
                        end;
{
  Now the mundane matters - copy out the stored file ...
}
                LZYes : begin
                          Assign(DestFile, BigNames);
                          Rewrite(DestFile, 1);
                          if IOResult=0 then begin
                            LZReportProc := aProc;
                            if Assigned(aProc) then aProc(RepRec, -1);
                            MyFCopy(SrcFile,DestFile,
                                     BigSizes,doReportOnWrite);
                            Close(DestFile);
                            if IOResult<>0 then;
                            if Assigned(aProc) then
                              begin
                                RepRec.Names := '';
                                aProc(RepRec, -2)
                              end
                          end
                        end
              end
        end
      else begin (* Is compressed ... *)

      Rewrite(TempFile, 1);
      If IOResult <> 0 then begin
        LZDearchive := -200; {big error}
        Break
      end;

    {write header}
      With f do begin
        fName := ExtractFileName(BigNames);
        Signature := ChiefLZSig;
        uSize     := uBigSizes;
        cSize     := BigSizes;
        fTime     := BigTimes;
        Version   := BigFileVersion;
      end;

      BlockWrite(TempFile, f, SizeOf(f)); {write header}
      If IOResult <> 0 then begin
        Close(TempFile); { No possible error; no buffered IO, Rewrite() OK. }
        Break
      end;

      Total := 0;
      repeat
        BRead := Min(BigSizes-Total, SizeOf(Buf^));
   { If the file is shorter than it should be, IO-Error }
        BlockRead(SrcFile, Buf^, BRead);
        if IOResult = 0 then
          begin
   { If the output disc runs out of space, IO-Error }
            BlockWrite(TempFile, Buf^, BRead);
            if IOResult = 0 then
              begin
                inc(Total, BRead);
                Continue
              end
          end;
   { Error-handling: clean-up code ... }
        Close(TempFile); if IOResult <> 0 then;
        Close(SrcFile);  { Reset() Ok; hence Close() must succeed. }
        FreeMem(jr, BigMemRec);
        Dispose(Buf);
        Exit
      until (Total >= BigSizes);

      Close(TempFile); if IOResult<>0 then;

    {decompress the temporary file}
      if LZDecompress(Str2PChar(TempName),Str2PChar(BigNames),
                      LZQuestion,aProc) = -150 then
        begin                      { User requested Abort !! }
          Erase(TempFile); if IOResult <> 0 then;
          LZDearchive := Pred(i);
          Break
        end

    end;

    LZDearchive := i;

    {goto location of next file in archive}
    Inc(LZFilePos, BigSizes);
    Seek(SrcFile, LZFilePos);
    If IOResult <> 0 then
      Break;

    Erase(TempFile);if IOResult<>0 then;

  end; { DirCount+1 <= i <= Count) }

  Dispose(Buf);
  end; { Buf <> nil }

  FreeMem(jr, BigMemRec);
  end; { jr <> nil ... }

  end; { IOResult = 0 after BlockRead(SrcFile,... }

  Close(SrcFile); { Reset() Ok; hence Close() must succeed. }

  end; { IOResult = 0 after Reset(SrcFile,1) }
{$endif}
End;

{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
Function LZCompressEx(const {$ifdef Win32} Name:  string
                            {$else}        aName: PChar
                            {$endif};
                      ReplaceQuestion:TLZQuestionFunc;
                      aProc:TLZReportProc): LongInt;
{$ifdef aDLL} {$ifdef Win32} stdcall
              {$else Win32}  export
              {$endif Win32};
{$endif aDLL}

Var
{$ifndef Win32}
Name: string;
{$endif}
NewName: string;
Begin
{$ifndef Win32}
  Name := StrPas(aName);
{$endif}
  NewName := GetLZMarkedName(Name);
  LZCompressEx := LZCompress({$ifdef Win32} Name,  NewName,
                             {$else}        aName, Str2PChar(NewName),
                             {$endif} ReplaceQuestion, aProc);
End;
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
Function LZDecompressEx({$ifdef Win32} Name:  string
                        {$else}        aName: PChar
                        {$endif};
                        ReplaceQuestion:TLZQuestionFunc;
                        aProc:TLZReportProc): LongInt;
{$ifdef aDLL} {$ifdef Win32} stdcall
              {$else Win32}  export
              {$endif Win32};
{$endif aDLL}
Var
s2:string;
{$ifndef Win32}
s:    string;
Name: string;
{$endif}
OutName: {$ifdef Win32} string;
         {$else}        array[0..79] of Char;
         {$endif}
IsHeaderRead: boolean;

Begin
{$ifdef Win32}
  LZDecompressEx := 0;
{$else}
  LZDecompressEx := -100;
  Name := StrPas(aName);
{$endif}

  if Length(Name) <> 0 then
  begin

  IsHeaderRead := false;

  {see if source file exists}
  If Not FileExists(Name) then {look for name ending with MyLZMarker}
  begin
   {$ifdef Win32}
     s2 := Name;
   {$else}
     s2 := Uppercase(Name);
   {$endif}
     Name := GetLZMarkedName(Name);
{
  If Win32, then GetChiefLZFileName() will throw the correct exception when
  it tries to open Name. No need to do it manually.
}
   {$ifndef Win32}
     if not FileExists(Name) then {source file not found}
       Exit;
     aName := Str2PChar(Name);
   {$endif}

   {$ifdef Win32}
     OutName := GetChiefLZFileName(Name);   { read header ... }
     if AnsiCompareText( ExtractFileName(OutName),
                         ExtractFileName(s2) ) <> 0 then
       RaiseErrorStr(EChiefLZCompress,SWrongCompressedFile,OutName)
   {$else}
     GetChiefLZFileName(aName, OutName);
     s := Uppercase(StrPas(OutName));
     If ExtractFileName(s)<>ExtractFileName(s2) {wrong uncompressed file}
     then
       begin
         LZDecompressEx := -2; {wrong file}
         Exit
       end
   {$endif};
     IsHeaderRead := True
  end;
  {not FileExists}

  {$ifdef Win32}
  if not IsHeaderRead then
    OutName := GetChiefLZFileName(Name);

  if Length(OutName) > 0 then
    begin
     {check for same source and target}
      OutName := ExtractFileName(OutName);
      Name := ExpandFileName(Name);

      if AnsiCompareText(ExtractFileName(Name),OutName) = 0 then
        RaiseErrorStr(EChiefLZCompress,SSameFileName,Name);

      Insert(ExtractFilePath(Name),OutName,1);
      LZDecompressEx := LZDecompress(Name, OutName, ReplaceQuestion, aProc)
    end

  {$else Win32}

  if not IsHeaderRead then
    GetChiefLZFileName(aName, OutName);

  if StrLen(OutName) > 0 then begin
    s  := ExtractFileName(StrPas(OutName)); {get just file name}
    s2 := ExtractFilePath(Name);       {does source file have path?}
    If Length(s2) = 0 then
      GetDir(0, s2);                   {if not, use current directory}
    s2 := AddBackSlash(s2); {add '\'}
    Insert(s2,s,1);   {target file}

    {check for same source and target}
    If Length(ExtractFilePath(Name)) = 0 then
      Insert(s2,Name,1);

    If Uppercase(Name)=Uppercase(s) then
      LZDecompressEx := -3  {same source & target}
    else
      LZDecompressEx := LZDecompress(aName,Str2PChar(s),ReplaceQuestion,aProc)
  end; { StrLen(OutName) > 0 }
  {$endif Win32}

  end; { Length(Name) <> 0 }
End;

{////////////////////////////////////////////////////}
{////////////////////////////////////////////////////}
{////////////////////////////////////////////////////}
{///   implementation of LZ object  /////////////////}
{////////////////////////////////////////////////////}
{//////  CANNOT BE USED BY .DLL  ////////////////////}
{////////////////////////////////////////////////////}
{////////////////////////////////////////////////////}
{$ifndef aDLL}
Constructor LZObj.{$ifdef Delphi} Create {$else} Init {$endif};
Begin
{$ifndef Win32}   { Delphi 2.0 automatically zeros new objects }
   ReportProc := Nil;
   QuestionProc := Nil;
   {$ifdef Delphi}
   FInputName[0] := #0;
   FOutputName[0] := #0;
   {$else}
   IsInited := False;
   InputName[0] := #0;
   OutputName[0] := #0;
   {$endif}
{$endif}

{$ifdef Delphi}
 {$ifDef Win32}
  FInputName := InFName;
  FOutputName := OutFName;
 {$else Win32}
 StrPCopy(FInputName, InFName);
 StrPCopy(FOutputName, OutFName);
 {$Endif Win32}
{$else}
  SetInputName(InFName);
  SetOutputName(OutFName);
{$endif}
End;
{////////////////////////////////////////////////////}
Destructor LZObj.{$ifdef Delphi} Destroy {$else} Done {$endif};
Begin
{$ifdef Win32}
  SetLength(FInputName,0);
  SetLength(FOutputName,0);
{$else}
{$ifdef Delphi}
   FInputName[0] := #0;
   FOutputName[0] := #0;
{$else}
   IsInited := False;
   InputName[0] := #0;
   OutputName[0] := #0;
{$endif}
{$endif}
{$ifdef Delphi}
   FReportProc := Nil;
   FQuestionProc := Nil;
{$else}
   ReportProc := Nil;
   QuestionProc := Nil;
{$endif}
End;
{////////////////////////////////////////////////////}
{$ifdef Delphi}
Function LZObj.GetIsInited: boolean;
begin
{$ifdef Win32}
  GetIsInited := Length(FInputName) > 0;
{$else}
  GetIsInited := StrLen(FInputName) > 0;
{$endif}
end;
{////////////////////////////////////////////////////}
{$else}
Procedure LZObj.SetInputName;
Begin
   If Length(aName)>0 then IsInited := True;
   StrPCopy(InputName, aName);
End;
{////////////////////////////////////////////////////}
Procedure LZObj.SetOutputName;
Begin
  StrPCopy(OutputName, aName);
End;
{$endif}
{////////////////////////////////////////////////////}
Function LZObj.Compress:Longint;
Begin
   if not IsInited then
     Compress := -100
   else if {$ifdef Win32} Length(FOutputName)
           {$else}        StrLen(OutputName)
           {$endif} > 0 then
     Compress := LZCompress(InputName, OutputName, QuestionProc, ReportProc)
   else
     Compress := LZCompressEx(InputName, QuestionProc, ReportProc)
End;
{////////////////////////////////////////////////////}
Function LZObj.Decompress:Longint;
Begin
   if not IsInited then
     Decompress := -100
   else if {$ifdef Win32} Length(FOutputName)
           {$else}        StrLen(OutputName)
           {$endif} > 0 then
     Decompress := LZDeCompress(InputName, OutputName, QuestionProc, ReportProc)
   else
     Decompress := LZDeCompressEx(InputName, QuestionProc, ReportProc)
End;
{////////////////////////////////////////////////////}
{$ifndef Delphi}
Procedure LZObj.SetReportProc;
Begin
  ReportProc := aProc;
End;
{////////////////////////////////////////////////////}
Procedure LZObj.SetQuestionProc;
Begin
  QuestionProc := aProc;
End;
{$endif Delphi}
{$endif aDLL}

{/////////////////////////////////////////////////////////}
{$IFNDEF Win32}
Function HeapFunc(Size: Word): Integer; far; assembler;
Asm
  MOV AX, 1
End; { HeapFunc }
{$ENDIF}

{////////////////////////////////////////////////////}
{////////////////////////////////////////////////////}
{////////////////////////////////////////////////////}
{////////////////////////////////////////////////////}
{////////////////////////////////////////////////////}
{$ifdef aDLL}
{
  Procedural interface to allow MyLZMarker to be modified if a DLL.
  Utterly redundant if NOT DLL, since MyLZMarker is published in the
  interface and we WANT to grant read/write access.
}
function GetLZMarkerChar: Char; {$ifdef Win32} stdcall {$else} export {$endif};
begin
  GetLZMarkerChar := MyLZMarker
end;

procedure SetLZMarkerChar(const NewChar: Char);
{$ifdef Win32} stdcall {$else} export {$endif};
begin
  MyLZMarker := NewChar
end;

function ChiefLZDLLVersion: Integer;
{$ifdef Win32} stdcall {$else} export {$endif Win32};
begin
  ChiefLZDLLVersion := ChiefLZVersionNumber
end;

Exports
   LZCompress            index 1  {$ifdef Win32} name 'LZCompress' {$endif},
   LZDecompress          index 2  {$ifdef Win32} name 'LZDecompress' {$endif},
   IsChiefLZFile         index 3  {$ifdef Win32} name 'IsChiefLZFile' {$endif},
   LZArchive             index 4  {$ifdef Win32} name 'LZArchive' {$endif},
   LZDearchive           index 5  {$ifdef Win32} name 'LZDearchive' {$endif},
   IsChiefLZArchive      index 6  {$ifdef Win32} name 'IsChiefLZArchive' {$endif},
   GetChiefLZFileName    index 7  {$ifdef Win32} name 'GetChiefLZFileName' {$endif},
   GetChiefLZFileSize    index 8  {$ifdef Win32} name 'GetChiefLZFileSize' {$endif},
   GetChiefLZArchiveInfo index 9  {$ifdef Win32} name 'GetChiefLZArchiveInfo' {$endif},
   LZCompressEx          index 10 {$ifdef Win32} name 'LZCompressEx' {$endif},
   LZDeCompressEx        index 11 {$ifdef Win32} name 'LZDecompressEx' {$endif},
   GetLZMarkerChar       index 12 {$ifdef Win32} name 'GetLZMarkerChar' {$endif},
   SetLZMarkerChar       index 13 {$ifdef Win32} name 'SetLZMarkerChar' {$endif},
   GetFullLZName         index 14 {$ifdef Win32} name 'GetFullLZName' {$endif},
   ChiefLZDLLVersion     index 15 {$ifdef Win32} name 'ChiefLZDLLVersion' {$endif},
   GetChiefLZArchiveSize index 16 {$ifdef Win32} name 'GetChiefLZArchiveSize' {$endif};

{$endif aDLL}

{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
{$ifdef Win32}
{
  Delphi 2.00 does some VERY nasty things to DLLs if:
(a) You include an initialisation section (even an empty one)
and
(b) You declare an uninitialised Global string variable; either
    on its own or as part of a record.

  I have therefore tried to work around this by pre-initialising as
  many of the global variables as possible (in the 32-bit code). Note
  that BlankRec contains a field called Name, which is a long-string
  in the Delphi 2 version !!!
}
{$ifdef aDLL}
begin          { <<< Crash And Burn warning !!!! }
{$else aDLL}   { Must have NO uninitialised global long-string vars!! }
initialization
{$endif aDLL}
{$else Win32}
Begin
{
  These variables can be initialised here in the 16-bit version ...
}
  HeapError := @HeapFunc;  { Specific to 16-bit code }

  FillChar(BlankRec, SizeOf(BlankRec), 0);
  LZReportProc := Nil;
{$endif Win32}
  Decompressing :=False;
{
  These variables MUST be initialised here ...
}
  LZReadProc  := MyReadProc;
  LZWriteProc := MyWriteProc
End.